home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PD Collection CD 1
/
PD Collection CD 1.iso
/
programer2
/
pari2
/
pari
/
other
/
mp_news
< prev
next >
Wrap
Text File
|
1991-11-08
|
126KB
|
6,181 lines
*********************************************************************
*===================================================================*
** **
*= =*
** **
*= oooooooooo ooooo oooooooooo ooooo =*
** ooooooooooo ooooooooo ooooooooooo ooo **
** ooo ooo ooo ooo ooo ooo ooo **
*= ooo ooo ooo ooo ooo ooo ooo =*
** ooooooooooo ooooooooooo oooooooooo ooo **
*= oooooooooo ooooooooooo ooooooooooo ooo =*
** ooo ooo ooo ooo ooo ooo **
*= ooo ooo ooo ooo ooo ooo =*
** ooooo ooooo ooooo ooooo ooooo ooooo **
** **
*= =*
** version numero 2 **
** **
*= commentee =*
** **
*= fichier cree le 22 sept. 1987 =*
** **
*= par =*
** **
*= christian batut , henri cohen , michel olivier =*
** **
*= """""""""""""""""""""""""""""""""""""""""""""" =*
** **
** **
*===================================================================*
*********************************************************************
*-------------------------------------------------------------------*
* *
* Notations : *
* T = type ( S , I , ou R ). *
* R = type reel. *
* S = type entier court ( long du C). *
* P = p-adique. *
* *
* L = longueur de la mantisse pour un reel ; *
* longueur de la mantisse effective pour un entier*
* l = longueur totale du nombre avec codage. *
* le= longueur effective totale de l'entier avec code *
* on doit avoir : l <= 2^15-1. *
* *
* exp = exposant non biaise d'un reel. *
* fexp= exposant biaise ( fexp = exp + 2^23 ). *
* on doit avoir : -2^23 <= exp < 2^23 *
* fvalp=valuation p-adique biaisee d'un p-adique. *
* ( fvalp = valuation + 2^15 ) *
* *
*-------------------------------------------------------------------*
*-------------------------------------------------------------------*
* *
* Conventions : *
* Tous les sous programmes creent la place necessaire *
* pour stocker le resultat , a l'exception des *
* programmes d'affectation et d'echange , ainsi que *
* des programmes dont le nom se termine par la lettre *
* "z" . On entre dans ces derniers avec une zone creee*
* dans la pile PARI ou le resultat est range. *
* *
* Le nombre reel 0 s'ecrit avec mantisse non *
* significative;le deuxieme lgmot code contient *
* -32*L + (2^23) ou L est la longueur de la mantisse *
* *
* Les registres a0,a1,d0,d1 sont en general utilises *
* par les programmes et ne sont pas restaures a leurs *
* valeurs d'entree.Tous les autres sont sauvegardes. *
* *
* Les objets utilises par PARI sont crees dans une *
* pile dite dans la suite "pile PARI",pointee par *
* _avma. *
* *
*-------------------------------------------------------------------*
#define affer1 1
#define affer2 2
#define affer3 3
#define affer4 4
#define affer5 5
#define exger1 6
#define exger2 7
#define shier1 8
#define shier2 9
#define truer1 10
#define truer2 11
#define adder1 12
#define adder2 13
#define adder3 14
#define adder4 15
#define adder5 16
#define muler1 17
#define muler2 18
#define muler3 19
#define muler4 20
#define muler5 21
#define muler6 22
#define diver1 23
#define diver2 24
#define diver3 25
#define diver4 26
#define diver5 27
#define diver6 28
#define diver7 29
#define diver8 30
#define diver9 31
#define diver10 32
#define diver11 33
#define diver12 34
#define divzer1 35
#define dvmer1 36
#define dvmzer1 37
#define moder1 38
#define modzer1 39
#define reser1 40
#define reszer1 41
#define arier1 42
#define arier2 43
#define errpile 44
#define rtodber 45
#define gerper 46
.text
.globl _typ
.globl _lg
.globl _lgef
.globl _mant
.globl _signe
.globl _expo
.globl _pere
.globl _valp
.globl _precp
.globl _varn
.globl _settyp
.globl _setlg
.globl _setlgef
.globl _setmant
.globl _setsigne
.globl _setexpo
.globl _expi
.globl _setpere
.globl _incpere
.globl _setvalp
.globl _setprecp
.globl _setvarn
.globl _cget
.globl _cgetg
.globl _cgeti
.globl _cgetr
.globl _cgiv
.globl _gerepile
.globl _mpaff
.globl _affsz
.globl _affsi
.globl _affsr
.globl _affii
.globl _affir
.globl _affrs
.globl _affri
.globl _affrr
.globl _stoi
.globl _itos
.globl _mpneg
.globl _mpnegz
.globl _negs
.globl _negi
.globl _negr
.globl _mpabs
.globl _mpabsz
.globl _abss
.globl _absi
.globl _absr
.globl _mptrunc
.globl _mptruncz
.globl _mpent
.globl _mpentz
.globl _mpexg
.globl _vals
.globl _vali
.globl _mpshift
.globl _mpshiftz
.globl _shifts
.globl _shifti
.globl _shiftr
.globl _mpcmp
.globl _cmpss
.globl _cmpsi
.globl _cmpsr
.globl _cmpis
.globl _cmpii
.globl _cmpir
.globl _cmprs
.globl _cmpri
.globl _cmprr
.globl _mpadd
.globl _addss
.globl _addsi
.globl _addsr
.globl _addii
.globl _addir
.globl _addrr
.globl _mpaddz
.globl _addssz
.globl _addsiz
.globl _addsrz
.globl _addiiz
.globl _addirz
.globl _addrrz
.globl _mpsub
.globl _subss
.globl _subsi
.globl _subsr
.globl _subis
.globl _subii
.globl _subir
.globl _subrs
.globl _subri
.globl _subrr
.globl _mpsubz
.globl _subssz
.globl _subsiz
.globl _subsrz
.globl _subisz
.globl _subiiz
.globl _subirz
.globl _subrsz
.globl _subriz
.globl _subrrz
.globl _mpmul
.globl _mulss
.globl _mulmodll
.globl _mulsi
.globl _mulsr
.globl _mulii
.globl _mulir
.globl _mulrr
.globl _mpmulz
.globl _mulssz
.globl _mulsiz
.globl _mulsrz
.globl _muliiz
.globl _mulirz
.globl _mulrrz
.globl _dvmdss
.globl _dvmdsi
.globl _dvmdis
.globl _dvmdii
.globl _mpdvmdz
.globl _dvmdssz
.globl _dvmdsiz
.globl _dvmdisz
.globl _dvmdiiz
.globl _mpdiv
.globl _divss
.globl _divsi
.globl _divsr
.globl _divis
.globl _divii
.globl _divir
.globl _divrs
.globl _divri
.globl _divrr
.globl _mpdivis
.globl _divise
.globl _mpdivz
.globl _divssz
.globl _divsiz
.globl _divsrz
.globl _divisz
.globl _diviiz
.globl _divirz
.globl _divrsz
.globl _divriz
.globl _divrrz
.globl _mpinvz
.globl _mpinvsr
.globl _mpinvir
.globl _mpinvrr
.globl _modss
.globl _modsi
.globl _modis
.globl _modii
.globl _mpmodz
.globl _modssz
.globl _modsiz
.globl _modisz
.globl _modiiz
.globl _resss
.globl _ressi
.globl _resis
.globl _resii
.globl _mpresz
.globl _resssz
.globl _ressiz
.globl _resisz
.globl _resiiz
.globl _convi
.globl _confrac
.globl _addsii
.globl _mulsii
.globl _divisii
*********************************************************************
*********************************************************************
*** ***
*** PROGRAMMES DE GESTION DE LA MEMOIRE PARI ***
*** ***
*********************************************************************
*********************************************************************
*===================================================================*
* *
* Allocation memoire dans pile PARI en C *
* *
* entree : a7@(4) contient la longueur totale a attribuer *
* sortie : d0 pointe sur un type I ou R *
* d1 et a1 sont inutilises *
* *
*===================================================================*
_cget: move.l 4(sp),d0
bsr.b _get
move.l a0,d0
rts
_cgetg: move.l 8(sp),d0
ror.l #8,d0
move.w 6(sp),d0
bsr.b _get
move.l a0,d0
rts
_cgeti: move.l 4(sp),d0
bsr.b _geti
move.l a0,d0
rts
_cgetr: move.l 4(sp),d0
bsr.b _getr
move.l a0,d0
rts
*===================================================================*
* *
* Allocation memoire dans pile PARI *
* *
* entree : d0.w contient le nombre total de longs mots *
* demandes si type I ou R *
* sortie : a0 pointe sur la zone allouee ; _avma est mis *
* a jour ; message d'erreur si memoire insuffisante ;*
* d0 est inchange;d1 et a1 sont sauvegardes. *
* remarque : il est interdit de creer des type S dans la pile *
* *
*===================================================================*
_get: move.l d1,-(sp)
moveq #0,d1
move.w d0,d1
lsl.l #2,d1
move.l _avma,a0
sub.l d1,a0
cmp.l _bot,a0
bmi.b mnet
move.l a0,_avma
swap d0
move.b #1,d0
swap d0
move.l d0,(a0)
move.l (sp)+,d1
rts
_geti: move.l d1,-(sp)
moveq #0,d1
move.w d0,d1
lsl.l #2,d1
move.l _avma,a0
sub.l d1,a0
cmp.l _bot,a0
bmi.b mnet
move.l a0,_avma
move.w #0x101,(a0)
move.w d0,2(a0)
move.l (sp)+,d1
rts
_getr: move.l d1,-(sp)
moveq #0,d1
move.w d0,d1
lsl.l #2,d1
move.l _avma,a0
sub.l d1,a0
cmp.l _bot,a0
bmi.b mnet
move.l a0,_avma
move.w #0x201,(a0)
move.w d0,2(a0)
move.l (sp)+,d1
rts
mnet: move.l #44,-(sp)
jsr _err
*===================================================================*
* *
* Desallocation memoire PARI en C *
* *
* entree : a7@(4) pointe sur un type I ou R *
* sortie : la zone occupee est desallouee *
* *
*===================================================================*
_cgiv: move.l 4(sp),a0
*===================================================================*
* *
* Desallocation memoire PARI *
* *
* entree : a0@ contient le premier long mot code d'une *
* zone memoire a desallouer : uniquement de type *
* I ou R *
* sortie : __avma est mis a jour si necessaire ; ou bien le *
* nombre de peres de la zone est decremente. *
* a0 pointe sur _avma a jour *
* tous les autres registres sont inchanges *
* *
*===================================================================*
_giv: move.l d0,-(sp)
cmp.b #0xff,1(a0)
beq.b givf
cmp.l _avma,a0
beq.b giv1
sub.b #1,1(a0)
givf: move.l (sp)+,d0
rts
giv1: sub.b #1,1(a0)
bne.b givf
1: move.w 2(a0),d0
lea (0,a0,d0.w*4),a0
move.l a0,_avma
tst.b 1(a0)
beq.b 1b
bra.b givf
*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*
* *
* GESTION DE PILE *
* *
* Entree : sp(4) et sp(8) contiennent 2 adresses l > p *
* sp(12) contient 0 ou une adresse q ;< *
* *
* Sortie : la zone entre p et l est ecrasee ; *
* - la zone entre _avma et p est decalee d'autant ; *
* - tous les pointeurs situes dans cette derniere *
* zone et qui pointent avant p sont mis a jour *
* et q est augmente du decalage . *
* ( d0 contient celui ci ou le decalage en octets )*
* - de plus si q est non nul la racine pointee par l *
* est mise a jour si il y a lieu . *
* - _avma est mis a jour ( augmente du decalage ) *
* *
*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*
_gerepile: movem.l d2-d6/a2-a3,-(sp)
move.l _avma,d5
move.l 32(sp),d2
move.l d2,a0
move.l d2,d4
move.l 36(sp),d1
move.l d1,a1
move.l d1,d0
sub.l d0,d2
bhi.b L1000
move.l 40(sp),d0
bra.w 9f
L1000: sub.l d5,d1
lsr.l #2,d1
bra.b 2f
1: move.l -(a1),-(a0)
2: dbra d1,1b
sub.l #0x10000,d1
bge.b 1b
move.l a0,_avma
clr.l d3
lea _lontyp,a3
*---------------------------------| mise a jour de la zone recopiee :
3: move.b (a0),d3
move.l (a3,d3.w*4),d1
lea (a0,d1.l*4),a1
move.w 2(a0),d1
move.l a0,a2
lea (a0,d1.w*4),a0
cmp.b #10,d3
bne.b L1301
move.w 6(a2),d6
cmp.w d1,d6
bhi.b 6f
lea (a2,d6.w*4),a2
bra.b 4f
L1301: move.l a0,a2
subq.l #4,a1
8: addq.l #4,a1
4: cmp.l a2,a1
bcc.b 6f
cmp.l (a1),d0
bls.b 5f
cmp.l (a1),d5
bhi.b 8b
add.l d2,(a1)+
bra.b 4b
5: cmp.l (a1)+,d4
bls.b 4b
cmp.l d4,a0
bhi.b 4b
move.l #46,-(sp)
jsr _err
6: cmp.l d4,a0
bcs.b 3b
bne.b 7f
tst.l 40(sp)
bne.b 3b
7: move.l d0,d1
move.l 40(sp),d0
beq.b L1101
cmp.l d0,d1
bls.b 9f
cmp.l d0,d5
bhi.b 9f
L1101: add.l d2,d0
9: movem.l (sp)+,d2-d6/a2-a3
rts
*********************************************************************
*********************************************************************
*** ***
*** TYPE , MANTISSE , LONGUEUR , EXPOSANT , SIGNE . ***
*** ***
*** VALUATION , PRECISION DES P-ADIQUES , VARIABLES. ***
*** ***
*********************************************************************
*********************************************************************
_typ: moveq #0,d0
move.b ([4,sp]),d0
rts
_settyp: move.b 11(sp),([4,sp])
rts
_varn: moveq #0,d0
move.b ([4,sp],5),d0
rts
_setvarn: move.b 11(sp),([4,sp],5)
rts
_mant: move.l 4(sp),a0
tst.b 4(a0)
bne.b 1f
moveq #0,d0
rts
1: move.w 10(sp),d0
move.l (4,a0,d0.w*4),d0
rts
_setmant: move.l 4(sp),a0
move.w 10(sp),d0
lea (4,a0,d0.w*4),a0
move.l 12(sp),(a0)
rts
_lg: moveq #0,d0
move.w ([4,sp],2),d0
rts
_setlg: move.w 10(sp),([4,sp],2)
rts
_lgef: moveq #0,d0
move.w ([4,sp],6),d0
rts
_setlgef: move.w 10(sp),([4,sp],6)
rts
_signe: move.b ([4,sp],4),d0
move.b ([4,sp]),d1
cmp.b #3,d1
bcs.b 1f
cmp.b #4,d1
beq.b 2f
cmp.b #5,d1
bne.b 1f
2: move.l ([4,sp],4),a0
move.b 4(a0),d0
1: extb.l d0
rts
_setsigne: move.b 11(sp),([4,sp],4)
rts
_pere: moveq #0,d0
move.b ([4,sp],1),d0
rts
_setpere: move.b 11(sp),([4,sp],1)
rts
_incpere: addq.b #1,([4,sp],1)
bne.b 1f
move.b #255,([4,sp],1)
1: rts
_expo: move.l ([4,sp],4),d0
and.l #0xffffff,d0
sub.l #0x800000,d0
rts
_expi: move.l 4(sp),a0
moveq #0,d0
move.w 6(a0),d0
subq.l #2,d0
lsl.l #5,d0
move.l 8(a0),d1
bfffo d1{0:32},d1
addq.l #1,d1
sub.l d1,d0
rts
_setexpo: move.l 8(sp),d0
add.l #0x800000,d0
move.l 4(sp),a0
move.b 4(a0),d1
move.l d0,4(a0)
move.b d1,4(a0)
rts
_valp: moveq #0,d0
move.w ([4,sp],6),d0
sub.l #0x8000,d0
rts
_setvalp: move.l 8(sp),d0
add.l #0x8000,d0
move.w d0,([4,sp],6)
rts
_precp: moveq #0,d0
move.w ([4,sp],4),d0
rts
_setprecp: move.l 8(sp),d0
move.l 4(sp),a0
move.w d0,4(a0)
rts
*********************************************************************
*********************************************************************
*** ***
*** PROGRAMMES D'AFFECTATION OU D'ECHANGE ***
*** ***
*********************************************************************
*********************************************************************
*===================================================================*
* *
* Affectation generale n2 --> n1 *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* a7(8) pointe sur n1 de type I ou R *
* sortie : la zone pointee par a7(8) contient n2 *
* interdit : n2 ou n1 de type S *
* remarques: erreur dans le cas R --> I *
* d0,d1,a0,a1 sont inchanges *
* *
*===================================================================*
_mpaff: cmp.b #1,([8,sp])
bne.b 1f
cmp.b #1,([4,sp])
beq.b _affii
bra.w _affri
1: cmp.b #1,([4,sp])
beq.w _affir
bra.w _affrr
*-------------------------------------------------------------------*
_affsz: cmp.b #2,([4,sp])
beq.w _affsr
_affsi: link a6,#0
movem.l d0/a0,-(sp)
move.l 8(a6),d0
move.l 12(a6),a0
cmp.w #2,2(a0)
bne.b 1f
tst.l d0
beq.b 4f
move.l #1,-(sp)
jsr _err
1: tst.l d0
4: bmi.b 2f
bne.b 3f
move.l #2,4(a0)
bra.b affsif
3: move.l #0x1000003,4(a0)
move.l d0,8(a0)
bra.b affsif
2: move.l #0xff000003,4(a0)
neg.l d0
move.l d0,8(a0)
affsif: movem.l (sp)+,d0/a0
unlk a6
rts
*-------------------------------------------------------------------*
_affii: link a6,#0
movem.l d0/a0-a1,-(sp)
move.l 8(a6),a1
move.l 12(a6),a0
cmp.l a0,a1
beq.b affiif
move.w 2(a0),d0
cmp.w 6(a1),d0
bcc.b 1f
move.l #3,-(sp)
jsr _err
1: move.w 6(a1),d0
subq.w #2,d0
addq.l #4,a0
addq.l #4,a1
2: move.l (a1)+,(a0)+
dbra d0,2b
affiif: movem.l (sp)+,d0/a0-a1
unlk a6
rts
*-------------------------------------------------------------------*
_itos: move.l a1,-(sp)
move.l 8(sp),a1
cmp.w #3,6(a1)
bls.b 1f
move.l #2,-(sp)
jsr _err
1: beq.b 2f
moveq #0,d0
bra.b itosf
2: move.l 8(a1),d0
cmp.l #0x80000000,d0
bcs.b 3f
beq.b 4f
5: move.l #2,-(sp)
jsr _err
4: tst.b 4(a1)
bpl.b 5b
bra.b itosf
3: tst.w 4(a1)
bpl.b itosf
neg.l d0
itosf: move.l (sp)+,a1
rts
*-------------------------------------------------------------------*
_stoi: move.l 4(sp),d1
bne.b 1f
move.l _gzero,d0
rts
1: move.l #3,d0
bsr _geti
tst.l d1
bmi.b 2f
move.l #0x1000003,4(a0)
bra.b 3f
2: move.l #0xff000003,4(a0)
neg.l d1
3: move.l d1,8(a0)
move.l a0,d0
rts
*-----------------------------------------------------------------------*
_affsr: link a6,#0
movem.l d0-d1/a0,-(sp)
move.l 12(a6),a0
move.l 8(a6),d0
bne.b 1f
moveq #0,d0
move.w 2(a0),d0
subq.w #2,d0
lsl.l #5,d0
neg.l d0
add.l #0x800000,d0
move.l d0,4(a0)
clr.l 8(a0)
bra.b affsrf
1: bpl.b 2f
neg.l d0
move.b #0xff,4(a0)
bra.b 3f
2: move.b #1,4(a0)
3: bfffo d0{0:32},d1
lsl.l d1,d0
neg.w d1
add.w #31,d1
move.w d1,6(a0)
move.b #0x80,5(a0)
move.l d0,8(a0)
moveq #0,d0
move.w 2(a0),d1
subq.l #3,d1
add.l #12,a0
bra.b 4f
5: move.l d0,(a0)+
4: dbra d1,5b
affsrf: movem.l (sp)+,d0-d1/a0
unlk a6
rts
*-------------------------------------------------------------------*
_affir: link a6,#0
movem.l d0-d6/a0-a1,-(sp)
move.l 8(a6),a1
move.l 12(a6),a0
tst.b 4(a1)
bne.b 1f
moveq #0,d0
move.w 2(a0),d0
subq.w #2,d0
lsl.l #5,d0
neg.l d0
add.l #0x800000,d0
move.l d0,4(a0)
clr.l 8(a0)
bra.b _affirf
1: move.l 8(a1),d0
bfffo d0{0:32},d1
lsl.l d1,d0
moveq #0,d2
move.w 6(a1),d2
lsl.l #5,d2
sub.l d1,d2
add.l #0x7fffbf,d2
move.l d2,4(a0)
move.b 4(a1),4(a0)
move.w 6(a1),d4
subq.w #3,d4
move.w 2(a0),d2
subq.w #3,d2
add.l #12,a1
addq.l #8,a0
moveq #1,d6
lsl.l d1,d6
subq.l #1,d6
sub.w d4,d2
bpl.b 2f
add.w d2,d4
bra.b 2f
3: move.l (a1)+,d3
rol.l d1,d3
move.l d3,d5
and.l d6,d3
add.l d3,d0
move.l d0,(a0)+
sub.l d3,d5
move.l d5,d0
2: dbra d4,3b
tst.w d2
bmi.b 4f
moveq #0,d3
move.l d0,(a0)+
bra.b 5f
6: move.l d3,(a0)+
5: dbra d2,6b
bra.b _affirf
4: move.l (a1)+,d3
rol.l d1,d3
and.l d6,d3
add.l d3,d0
move.l d0,(a0)+
_affirf: movem.l (sp)+,d0-d6/a0-a1
unlk a6
rts
*-------------------------------------------------------------------*
_affrr: link a6,#0
movem.l d0-d1/a0-a1,-(sp)
move.l 8(a6),a1
move.l 12(a6),a0
cmp.l a0,a1
beq.b affrrf
tst.b 4(a1)
bne.b 6f
move.l 4(a1),4(a0)
clr.l 8(a0)
bra.b affrrf
6: addq.l #4,a0
addq.l #4,a1
move.w -2(a0),d0
move.w -2(a1),d1
cmp.w d0,d1
bhi.b 1f
sub.w d1,d0
subq.w #2,d1
3: move.l (a1)+,(a0)+
dbra d1,3b
moveq #0,d1
bra.b 2f
4: move.l d1,(a0)+
2: dbra d0,4b
bra.b affrrf
1: subq.w #2,d0
5: move.l (a1)+,(a0)+
dbra d0,5b
affrrf: movem.l (sp)+,d0-d1/a0-a1
unlk a6
rts
*-------------------------------------------------------------------*
_affrs: move.l #4,-(sp)
jsr _err
*-------------------------------------------------------------------*
_affri: move.l #5,-(sp)
jsr _err
*===================================================================*
* *
* Echange de deux nombres *
* *
* entree : a7(4) contient l'adresse d'une zone z2 contemant *
* n2 de type I ou R ; a7(8) contient l'adresse d'une*
* zone z1 contenant n1 de type I ou R *
* sortie : a7(4) contient l'adresse de z2 contenant n1 *
* a7(8) contient l'adresse de z1 contenant n2 *
* d0,d1,a0,a1 sont sauvegardes *
* remarque : message d'erreur si impossible ; type S interdit *
* *
*===================================================================*
_mpexg: link a6,#0
movem.l d0-d4/a0-a2,-(sp)
move.l 8(a6),a2
move.l 12(a6),a1
move.b (a2),d2
move.b (a1),d1
cmp.b d1,d2
beq.b 1f
move.l #7,-(sp)
jsr _err
1: move.l (a1),d3
move.l (a2),d4
cmp.w d3,d4
bne.b 2f
subq.w #3,d3
addq.l #4,a1
addq.l #4,a2
6: move.l (a2),d4
move.l (a1),(a2)+
move.l d4,(a1)+
dbra d3,6b
bra.b exgf
2: cmp.b #1,d1
bne.b 3f
cmp.w d3,d4
ble.b 4f
exg a1,a2
exg d3,d4
4: cmp.w 6(a1),d4
bpl.b 5f
move.l #6,-(sp)
jsr _err
5: move.l d4,d0
bsr _geti
move.l a0,-(sp)
move.l a2,-(sp)
bsr _affii
addq.l #8,sp
move.l a2,-(sp)
move.l a1,-(sp)
bsr _affii
addq.l #8,sp
move.l a1,-(sp)
move.l a0,-(sp)
bsr _affii
addq.l #8,sp
bsr _giv
bra.b exgf
3: move.l d4,d0
bsr _getr
move.l a0,-(sp)
move.l a2,-(sp)
bsr _affrr
addq.l #8,sp
move.l a2,-(sp)
move.l a1,-(sp)
bsr _affrr
addq.l #8,sp
move.l a1,-(sp)
move.l a0,-(sp)
bsr _affrr
addq.l #8,sp
bsr _giv
exgf: movem.l (sp)+,d0-d4/a0-a2
unlk a6
rts
*********************************************************************
*********************************************************************
*** ***
*** PROGRAMMES DE CHANGEMENT DE SIGNE ***
*** ***
*********************************************************************
*********************************************************************
*===================================================================*
* *
* Negation generale *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* sortie : d0 pointe sur n1 de type I ou R *
* contenant n1 = -n2 (zone creee) *
* interdit : type S *
* *
*===================================================================*
_mpneg: cmp.b #1,([4,sp])
beq.b _negi
bra.w _negr
*===================================================================*
* *
* Negation (par valeur) *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* a7(8) pointe sur n1 de type I ou R *
* sortie : la zone pointee par a7(8) contient -n2 *
* interdit : type S *
* *
*===================================================================*
_mpnegz: move.l 4(sp),a0
cmp.l 8(sp),a0
bne.b 1f
neg.b 4(a0)
rts
1: move.l 4(sp),-(sp)
bsr _mpneg
move.l d0,-(sp)
move.l 16(sp),4(sp)
bsr _mpaff
move.l (sp),a0
addq.l #8,sp
bra.w _giv
*===================================================================*
* *
* Negation *
* *
* entree : a7(4) contient un type S ou pointe sur un *
* type I ou R , soit n2 *
* sortie : d0 pointe sur un type I ou R ,soit n1=-n2 *
* (zone creee) *
* *
*===================================================================*
_negs: move.l 4(sp),d1
bne.b 1f
move.l _gzero,d0
rts
1: moveq #3,d0
bsr _geti
move.l a0,d0
move.l #0x1000003,4(a0)
neg.l d1
bpl.b 2f
move.b #0xff,4(a0)
neg.l d1
2: move.l d1,8(a0)
rts
*-------------------------------------------------------------------*
_negi: move.l 4(sp),a1
move.w 6(a1),d1
move.l d1,d0
bsr _geti
move.l a0,d0
addq.l #4,a0
addq.l #4,a1
subq.w #2,d1
1: move.l (a1)+,(a0)+
dbra d1,1b
move.l d0,a0
neg.b 4(a0)
rts
*-------------------------------------------------------------------*
_negr: move.l 4(sp),a1
move.l (a1),d1
move.l d1,d0
bsr _getr
move.l a0,d0
addq.l #4,a0
addq.l #4,a1
subq.w #2,d1
1: move.l (a1)+,(a0)+
dbra d1,1b
move.l d0,a0
neg.b 4(a0)
rts
*===================================================================*
* *
* Valeur absolue generale *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* sortie : d0 pointe sur n1 de type I ou R avec n1=abs(n2) *
* de type I ou R (zone creee) *
* interdit : type S *
* *
*===================================================================*
_mpabs: cmp.b #1,([4,sp])
beq.b _absi
bra.w _absr
*===================================================================*
* *
* Valeur absolue (par valeur) *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* a7(8) pointe sur n1 de type I ou R *
* sortie : la zone pointee par a7(8) contient abs(n2) *
* interdit : type S *
* *
*===================================================================*
_mpabsz: move.l 4(sp),a0
cmp.l 8(sp),a0
bne.b 1f
and.b #1,4(a0)
rts
1: move.l 4(sp),-(sp)
bsr _mpabs
move.l d0,-(sp)
move.l 16(sp),4(sp)
bsr _mpaff
move.l (sp),a0
addq.l #8,sp
bra.w _giv
*===================================================================*
* *
* Valeur absolue *
* *
* entree : a7(4) contient ou pointe sur n2 *
* sortie : d0 pointe sur i1 ou r1 (zone creee) *
* *
*===================================================================*
_abss: move.l 4(sp),d1
bne.b 1f
move.l _gzero,d0
rts
1: moveq #3,d0
bsr _geti
move.l a0,d0
move.l #0x1000003,4(a0)
tst.l d1
bpl.b 2f
neg.l d1
2: move.l d1,8(a0)
rts
*-------------------------------------------------------------------*
_absi: move.l 4(sp),a1
move.w 6(a1),d1
move.w d1,d0
bsr _geti
move.l a0,d0
cmp.w #2,d1
bne.b 1f
move.l #2,4(a0)
bra.b absif
1: move.l #0x1000000,4(a0)
move.w d1,6(a0)
addq.l #8,a1
addq.l #8,a0
subq.w #3,d1
2: move.l (a1)+,(a0)+
dbra d1,2b
absif: rts
*-------------------------------------------------------------------*
_absr: move.l 4(sp),a1
move.w 2(a1),d1
move.w d1,d0
bsr _getr
move.l a0,d0
subq.w #2,d1
addq.l #4,a1
addq.l #4,a0
1: move.l (a1)+,(a0)+
dbra d1,1b
move.l d0,a0
tst.b 4(a0)
bpl.b absrf
neg.b 4(a0)
absrf: rts
*********************************************************************
*********************************************************************
*** ***
*** VALUATION ***
*** ***
*********************************************************************
*********************************************************************
*===================================================================*
* *
* Valuation 2-adique d'un entier court ou d'un entier *
* *
* entree : a7(4) contient s1 de type S ou pointe sur i1 de *
* type I *
* sortie : d0.l contient k tel que : k>=0 , n1=2^k*n2 , *
* avec n2 et 2 premiers entre eux ; si n1=0 , alors *
* d0.l contient -1. *
* remarque : type R interdit *
* *
*===================================================================*
_vals: link a6,#0
move.l d2,-(sp)
moveq #-1,d0
move.l 8(a6),d1
beq.b valsf
moveq #0,d0
tst.w d1
bne.b 1f
add.l #16,d0
swap d1
1: tst.b d1
bne.b 2f
addq.l #8,d0
lsr.l #8,d1
2: move.l d1,d2
and.l #15,d2
bne.b 3f
addq.l #4,d0
lsr.l #4,d1
3: move.l d1,d2
and.l #3,d2
bne.b 4f
addq.l #2,d0
lsr.l #2,d1
4: btst #0,d1
bne.b valsf
addq.l #1,d0
valsf: move.l (sp),d2
unlk a6
rts
_vali: link a6,#0
move.l d2,-(sp)
move.l 8(a6),a1
moveq #-1,d0
tst.b 4(a1)
beq.b valif
move.w 6(a1),d1
lea (a1,d1.w*4),a1
move.l #0xffff,d0
5: tst.l -(a1)
dbne d0,5b
not.w d0
lsl.l #5,d0
move.l (a1),d1
tst.w d1
bne.b 1f
add.l #16,d0
swap d1
1: tst.b d1
bne.b 2f
addq.l #8,d0
lsr.l #8,d1
2: move.l d1,d2
and.l #15,d2
bne.b 3f
addq.l #4,d0
lsr.l #4,d1
3: move.l d1,d2
and.l #3,d2
bne.b 4f
addq.l #2,d0
lsr.l #2,d1
4: btst #0,d1
bne.b valif
addq.l #1,d0
valif: move.l (sp),d2
unlk a6
rts
*********************************************************************
*********************************************************************
*** ***
*** PROGRAMMES DE SHIFT ***
*** ***
*********************************************************************
*********************************************************************
*===================================================================*
* *
* Shift general *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* a7(8) contient k = nombre de shifts *
* sortie : d0 pointe sur n1 de type I ou R *
* contenant n1 = 2^k * n2 (zone creee) *
* interdit : type S *
* *
*===================================================================*
_mpshift: cmp.b #1,([4,sp])
beq.w _shifti
bra.w _shiftr
*===================================================================*
* *
* Shift (par valeur) *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* a7(8) contient le nombre de shifts (=k) *
* a7(12) pointe sur n1 de type I ou R *
* sortie : la zone pointee par a7(12) contient 2^k * n2 *
* interdit : type S *
* *
*===================================================================*
_mpshiftz: move.l 4(sp),a0
cmp.l 12(sp),a0
bne.b 1f
cmp.b #2,(a0)
bne.b 1f
move.l 4(a0),d0
and.l #0xffffff,d0
add.l 8(sp),d0
bvs.w shier
cmp.l #0x1000000,d0
bcc.w shier
tst.l d0
bmi.w shier
move.w d0,6(a0)
swap d0
move.b d0,5(a0)
rts
1: move.l 8(sp),-(sp)
move.l 8(sp),-(sp)
bsr _mpshift
move.l d0,(sp)
move.l 20(sp),4(sp)
bsr _mpaff
move.l (sp),a0
addq.l #8,sp
bra.w _giv
*===================================================================*
* *
* Shift d'un entier court = entier *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) contient k = nombre de shifts *
* sortie : d0 pointe sur i1 de type I *
* avec i1 = 2^k * s2 (zone creee) *
* *
*===================================================================*
_shifts: link a6,#-12
move.l 12(a6),-(sp)
move.l 8(a6),d0
bne.b 1f
move.l #0x1000002,-12(a6)
move.l #2,-8(a6)
bra.b 3f
1: move.l #0x1000003,-12(a6)
move.l #0x1000003,-8(a6)
tst.l d0
bpl.b 2f
neg.l d0
move.b #0xff,-8(a6)
2: move.l d0,-4(a6)
3: pea -12(a6)
bsr _shifti
unlk a6
rts
*===================================================================*
* *
* Shift entier = entier *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) contient k = nombre de shifts *
* sortie : d0 pointe sur i1 de type I *
* avec i1 = 2^k * i2 (zone creee) *
* *
*===================================================================*
_shifti: link a6,#0
movem.l d2-d7/a2-a3,-(sp)
move.l 8(a6),a2
move.l 12(a6),d7
bne.b 1f
move.w 2(a2),d0
bsr _geti
move.l a0,a3
subq.w #2,d0
addq.l #4,a0
addq.l #4,a2
L2401: move.l (a2)+,(a0)+
dbra d0,L2401
bra.w shiftif
1: tst.b 4(a2)
bne.b 2f
6: move.l _gzero,d0
bra.w shiftig
2: moveq #0,d0
move.w 6(a2),d0
cmp.l #1,d7
bne.b 3f
move.l 8(a2),d5
btst #31,d5
beq.b 4f
addq.w #1,d0
cmp.w #0x8000,d0
bcs.b 4f
L1801: move.l #8,-(sp)
jsr _err
4: bsr _geti
move.l a0,a3
move.w 2(a0),6(a0)
move.b 4(a2),4(a0)
lea (a0,d0.w*4),a1
lea (a2,d0.w*4),a2
btst #31,d5
beq.b 5f
subq.w #4,a2
move.l #1,8(a0)
subq.w #1,d0
5: subq.w #3,d0
7: move.l -(a2),d1
roxl.l #1,d1
move.l d1,-(a1)
dbra d0,7b
bra.w shiftif
3: cmp.l #-1,d7
bne.b 8f
cmp.l #1,8(a2)
bhi.b 9f
subq.w #1,d0
cmp.w #2,d0
beq.w 6b
9: bsr _geti
move.l a0,a3
move.b 4(a2),4(a0)
move.w 2(a0),6(a0)
addq.l #8,a0
addq.l #8,a2
move.w -2(a2),d0
subq.w #3,d0
move.l (a2)+,d1
lsr.l #1,d1
beq.b L1001
move.l d1,(a0)+
bra.b L1001
L1102: move.l (a2)+,d1
roxr.l #1,d1
move.l d1,(a0)+
L1001: dbra d0,L1102
bra.w shiftif
8: tst.l d7
bpl.b L1201
neg.l d7
move.l d7,d4
lsr.l #5,d4
and.l #31,d7
sub.w d4,d0
cmp.w #2,d0
bls.w 2b
move.l 8(a2),d4
lsr.l d7,d4
bne.b L1302
subq.w #1,d0
cmp.w #2,d0
beq.w 6b
L1302: bsr _geti
move.l a0,a3
move.b 4(a2),4(a0)
move.w 2(a0),6(a0)
lea (a2,d0.w*4),a2
lea (a0,d0.w*4),a1
tst.l d4
beq.b L1401
move.l d4,8(a0)
subq.w #3,d0
bra.b L1501
L1401: addq.l #4,a2
subq.w #2,d0
L1501: moveq #-1,d6
lsr.l d7,d6
move.l -(a2),d4
lsr.l d7,d4
bra.b L1601
L1701: move.l -(a2),d2
ror.l d7,d2
move.l d2,d3
and.l d6,d3
sub.l d3,d2
add.l d2,d4
move.l d4,-(a1)
move.l d3,d4
L1601: dbra d0,L1701
bra.b shiftif
L1201: move.l d7,d4
and.l #31,d7
lsr.l #5,d4
add.l d4,d0
cmp.w #0x7fff,d0
bcc.w L1801
moveq #-1,d6
lsl.l d7,d6
not.l d6
move.l 8(a2),d2
rol.l d7,d2
move.l d2,d3
and.l d6,d3
beq.b L1901
addq.w #1,d0
L1901: bsr _geti
move.l a0,a3
move.l 2(a0),6(a0)
move.b 4(a2),4(a0)
addq.l #8,a0
tst.l d3
beq.b L2001
move.l d3,(a0)+
L2001: sub.l d3,d2
move.l d2,d5
move.w 6(a2),d0
add.l #12,a2
subq.w #3,d0
bra.b L2101
L2201: move.l (a2)+,d2
rol.l d7,d2
move.l d2,d3
and.l d6,d3
sub.l d3,d2
add.l d3,d5
move.l d5,(a0)+
move.l d2,d5
L2101: dbra d0,L2201
move.l d5,(a0)+
moveq #0,d0
bra.b L2301
L2501: move.l d0,(a0)+
L2301: dbra d4,L2501
shiftif: move.l a3,d0
shiftig: movem.l (sp)+,d2-d7/a2-a3
unlk a6
rts
*===================================================================*
* *
* Shift reel = reel *
* *
* entree : a7(4) pointe sur r2 de type R *
* a7(8) contient k = nombre de shifts *
* sortie : d0 pointe sur r1 de type R *
* avec r1 = 2^k * r2 zone creee) *
* *
*===================================================================*
_shiftr: link a6,#0
movem.l d2/a2-a3,-(sp)
move.l 8(a6),a2
move.l 12(a6),d2
bne.b 1f
move.w 2(a2),d0
bsr _getr
move.l a0,a3
subq.w #2,d0
addq.l #4,a0
addq.l #4,a2
4: move.l (a2)+,(a0)+
dbra d0,4b
bra.b shiftrf
1: move.l 4(a2),d1
and.l #0xffffff,d1
add.l d2,d1
bvc.b sh
shier: move.l #9,-(sp)
jsr _err
sh: cmp.l #0x1000000,d1
bcc.b shier
tst.l d1
bmi.b shier
move.w 2(a2),d0
bsr _getr
move.l a0,a3
move.l d1,4(a0)
move.b 4(a2),4(a0)
addq.l #8,a0
addq.l #8,a2
subq.w #3,d0
5: move.l (a2)+,(a0)+
dbra d0,5b
shiftrf: move.l a3,d0
movem.l (sp)+,d2/a2-a3
unlk a6
rts
*********************************************************************
*********************************************************************
*** ***
*** PROGRAMMES DE PARTIE ENTIERE ***
*** ***
*********************************************************************
*********************************************************************
*===================================================================*
* *
* Fausse partie entiere (trunc) *
* *
* entree : a7(4) pointe sur n1 de type I ou de type R *
* sortie : d0 pointe sur i1 de type I (zone creee) *
* calcul : si r1 >= 0 , i1 est la partie entiere *
* si r1 < 0 , i1 = - Ent (-r1) *
* remarque : type S interdit *
* *
*===================================================================*
_mptrunc: link a6,#0
movem.l d2-d6/a2-a4,-(sp)
move.l 8(a6),a1
cmp.b #1,(a1)
bne.b 5f
move.w 6(a1),d0
bsr _geti
move.l a0,a4
subq.w #2,d0
addq.l #4,a0
addq.l #4,a1
7: move.l (a1)+,(a0)+
dbra d0,7b
bra.w truncf
5: move.l 4(a1),d3
move.l d3,d0
and.l #0xffffff,d0
sub.l #0x800000,d0
bpl.b 1f
move.l _gzero,d0
bra.b truncg
1: move.l d0,d2
lsr.l #5,d0
addq.l #3,d0
cmp.l #0x7fff,d0
bls.b 2f
move.l #10,-(sp)
jsr _err
2: bsr _geti
move.l a0,a4
move.w d0,6(a0)
move.b 4(a1),4(a0)
move.l a0,a3
addq.l #8,a0
addq.l #8,a1
move.w -6(a1),d1
sub.w d0,d1
bpl.b 3f
move.l #11,-(sp)
jsr _err
3: subq.w #3,d0
addq.b #1,d2
and.b #31,d2
bne.b 4f
8: move.l (a1)+,(a0)+
dbra d0,8b
bra.b truncf
4: moveq #1,d6
lsl.l d2,d6
subq.l #1,d6
moveq #0,d5
6: move.l (a1)+,d3
rol.l d2,d3
move.l d3,d4
and.l d6,d4
sub.l d4,d3
add.l d5,d4
move.l d4,(a0)+
move.l d3,d5
dbra d0,6b
truncf: move.l a4,d0
truncg: movem.l (sp)+,d2-d6/a2-a4
unlk a6
rts
*===================================================================*
* *
* Fausse partie entiere (par valeur) *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* a7(8) pointe sur n1 de type I ou R *
* sortie : la zone pointee par a7(8) contient trunc(n2) *
* interdit : type S *
* *
*===================================================================*
_mptruncz: move.l 4(sp),-(sp)
bsr _mptrunc
move.l 12(sp),(sp)
move.l d0,-(sp)
bsr _mpaff
move.l d0,a0
addq.l #8,sp
bra.w _giv
*===================================================================*
* *
* Partie entiere ( max { n <= x} ) *
* *
* entree : a7(4) pointe sur n1 de type I ou R *
* sortie : d0 pointe sur i1 de type I (zone creee) *
* remarque : type S interdit *
* *
*===================================================================*
_mpent: link a6,#0
movem.l d2-d6/a2-a4,-(sp)
move.l 8(a6),a1
cmp.b #1,(a1)
bne.b 1f
move.w 6(a1),d0
bsr _geti
move.l a0,a4
subq.w #2,d0
addq.l #4,a0
addq.l #4,a1
6: move.l (a1)+,(a0)+
dbra d0,6b
bra.w entf
1: tst.b 4(a1)
blt.b 2f
move.l 8(a6),-(sp)
bsr _mptrunc
move.l d0,a4
addq.l #4,sp
bra.w entf
2: move.l 4(a1),d3
and.l #0xffffff,d3
sub.l #0x800000,d3
bpl.b 3f
moveq #3,d0
bsr _geti
move.l a0,a4
move.l #0xff000003,4(a0)
move.l #1,8(a0)
bra.b entf
3: move.l _avma,a3
move.l 8(a6),-(sp)
bsr _mptrunc
move.l d0,a4
addq.l #4,sp
move.l d3,d1
lsr.l #5,d3
and.l #31,d1
move.l 8(a6),a1
lea (8,a1,d3.l*4),a2
move.l #0x80000000,d6
lsr.l d1,d6
subq.l #1,d6
moveq #0,d2
move.w 2(a1),d2
subq.l #3,d2
sub.l d3,d2
move.l (a2)+,d5
and.l d6,d5
beq.b 4f
bra.b 5f
7: tst.l (a2)+
4: dbne d2,7b
bne.b 5f
bra.b entf
5: move.l a4,-(sp)
move.l #0xffffffff,-(sp)
bsr _addsi
addq.l #8,sp
move.l a4,a1
move.l a3,a4
move.l d0,a0
move.w 2(a0),d0
subq.w #1,d0
8: move.l -(a1),-(a4)
dbra d0,8b
move.l a4,_avma
entf: move.l a4,d0
movem.l (sp)+,d2-d6/a2-a4
unlk a6
rts
*===================================================================*
* *
* Partie entiere (par valeur) *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* a7(8) pointe sur n1 de type I ou R *
* sortie : la zone pointee par a7(8) contient ent(n2) *
* interdit : type S *
* *
*===================================================================*
_mpentz: move.l 4(sp),-(sp)
bsr _mpent
move.l 12(sp),(sp)
move.l d0,-(sp)
bsr _mpaff
move.l d0,a0
addq.l #8,sp
bra.w _giv
*********************************************************************
*********************************************************************
*** ***
*** PROGRAMMES DE COMPARAISON ***
*** ***
*********************************************************************
*********************************************************************
*===================================================================*
* *
* Comparaison generale *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* a7(8) pointe sur n1 de type I ou R *
* sortie : d0.l contient -1 si n2<n1,0 si n2=n1,1 sinon. *
* d1,a0,a1 sont sauvegardes *
* interdit : type S *
* *
*===================================================================*
_mpcmp: link a6,#0
movem.l d1-d2/a1-a2,-(sp)
move.l 8(a6),a2
move.l 12(a6),a1
moveq #0,d1
move.b (a2),d2
cmp.b (a1),d2
ble.b 1f
exg a1,a2
moveq #1,d1
1: move.l a1,-(sp)
move.l a2,-(sp)
cmp.b #1,(a1)
bne.b 2f
bsr _cmpii
bra.b cmpf
2: cmp.b #1,(a2)
bne.b 3f
bsr _cmpir
bra.b cmpf
3: bsr _cmprr
cmpf: addq.l #8,sp
tst.b d1
beq.b 1f
neg.l d0
1: movem.l (sp)+,d1-d2/a1-a2
unlk a6
rts
*===================================================================*
* *
* Comparaison : entier court et entier court *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) contient s1 de type S *
* sortie : d0.l contient -1 si s2<s1,0 si s2=s1,1 sinon *
* d1,a0,a1 sont sauvegardes *
* *
*===================================================================*
_cmpss: link a6,#0
movem.l d1-d2,-(sp)
move.l 8(a6),d2
move.l 12(a6),d1
cmp.l d1,d2
beq.b 1f
bpl.b 2f
moveq #-1,d0
bra.b cmpssf
2: moveq #1,d0
bra.b cmpssf
1: moveq #0,d0
cmpssf: movem.l (sp)+,d1-d2
unlk a6
rts
*===================================================================*
* *
* Comparaison : entier court et entier *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) pointe sur i1 de type I *
* sortie : d0.l contient 1 si s2>i1,0 si s2=i1,-1 sinon *
* d1,a0,a1 sont sauvegardes *
* *
*===================================================================*
_cmpsi: link a6,#0
movem.l d1-d4/a1,-(sp)
move.l 12(a6),a1
move.b 4(a1),d1
move.b d1,d4
move.b #1,d3
move.l 8(a6),d2
bgt.b 1f
bne.b 2f
move.b #0,d3
bra.b 1f
2: move.b #-1,d3
1: eor.b d3,d4
bpl.b 3f
moveq #1,d0
tst.b d3
bpl.b 4f
moveq #-1,d0
4: bra.b cmpsif
3: cmp.w #3,6(a1)
ble.b 5f
8: moveq #-1,d0
tst.b d1
bpl.b 6f
neg.l d0
6: bra.b cmpsif
5: cmp.w #2,6(a1)
beq.b 7f
tst.l d2
bpl.b 9f
neg.l d2
9: moveq #1,d0
cmp.l 8(a1),d2
bhi.b L1002
bne.b L1103
moveq #0,d0
bra.b cmpsif
L1103: moveq #-1,d0
L1002: tst.b d1
bpl.b cmpsif
neg.l d0
bra.b cmpsif
7: moveq #1,d0
tst.b d3
bne.b cmpsif
moveq #0,d0
cmpsif: movem.l (sp)+,d1-d4/a1
unlk a6
rts
*===================================================================*
* *
* Comparaison : entier court et reel *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) pointe sur r1 de type R *
* sortie : d0.l contient 1 si s2>r1, 0 si s2=r1, -1 sinon *
* d1,a0,a1 sont sauvegardes *
* *
*===================================================================*
_cmpsr: link a6,#0
movem.l d1-d4/a0-a2,-(sp)
move.l 12(a6),a1
move.b 4(a1),d1
move.b d1,d4
move.b #1,d3
move.l 8(a6),d2
bgt.b 1f
bne.b 2f
move.b #0,d3
bra.b 1f
2: move.b #-1,d3
1: eor.b d3,d4
bpl.b 3f
moveq #1,d0
tst.b d3
bpl.b 4f
moveq #-1,d0
4: bra.b cmpsrf
3: tst.b d1
bne.b 5f
moveq #1,d0
tst.b d3
bne.b 6f
moveq #0,d0
6: bra.b cmpsrf
5: move.w 2(a1),d0
bsr _getr
move.l a0,a2
move.l a0,-(sp)
move.l d2,-(sp)
bsr _affsr
addq.l #8,sp
move.l a1,-(sp)
move.l a0,-(sp)
bsr _cmprr
addq.l #8,sp
move.l a2,a0
bsr _giv
cmpsrf: movem.l (sp)+,d1-d4/a0-a2
unlk a6
rts
*===================================================================*
* *
* Comparaison : entier et entier court *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) contient s1 *
* sortie : d0.l contient le signe de i2 - s1 *
* aucun autre registre n'est affecte *
* *
*===================================================================*
_cmpis: move.l 4(sp),-(sp)
move.l 12(sp),-(sp)
bsr _cmpsi
addq.l #8,sp
neg.l d0
rts
*===================================================================*
* *
* Comparaison : entier et entier *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) pointe sur i1 de type I *
* sortie : d0.l contient :1 si i2>i1,0 si i2=i1,-1 sinon *
* d1,a0,a1 sont sauvegardes *
* *
*===================================================================*
_cmpii: link a6,#0
movem.l d1-d4/a1-a2,-(sp)
move.l 8(a6),a2
move.l 12(a6),a1
move.b 4(a1),d1
move.b d1,d4
move.b 4(a2),d2
eor.b d2,d4
bpl.b 1f
moveq #1,d0
tst.b d2
bpl.b cmpiif
moveq #-1,d0
bra.b cmpiif
1: move.w 6(a1),d1
move.w 6(a2),d2
cmp.w d1,d2
blt.b 3f
beq.b 4f
6: moveq #1,d0
tst.b 4(a1)
bpl.b cmpiif
moveq #-1,d0
bra.b cmpiif
3: moveq #-1,d0
tst.b 4(a2)
bpl.b cmpiif
moveq #1,d0
bra.b cmpiif
4: cmp.w #2,d1
bne.b 7f
moveq #0,d0
bra.b cmpiif
7: move.b 4(a1),d3
addq.l #8,a1
addq.l #8,a2
subq.w #3,d1
L1104: cmpm.l (a1)+,(a2)+
dbne d1,L1104
bhi.b 8f
beq.b 9f
moveq #-1,d0
bra.b L1003
9: moveq #0,d0
bra.b cmpiif
8: moveq #1,d0
L1003: tst.b d3
bpl.b cmpiif
neg.l d0
cmpiif: movem.l (sp)+,d1-d4/a1-a2
unlk a6
rts
*===================================================================*
* *
* Comparaison : entier et reel *
* *
* entree : a7(4) pointe sur i2 de type R *
* a7(8) pointe sur r1 de type R *
* sortie : d0.l contient :1 si i2>r1,0 si i2=r1,-1 sinon *
* d1,a0,a1 sont sauvegardes *
* *
*===================================================================*
_cmpir: link a6,#0
movem.l d1-d4/a0-a3,-(sp)
move.l 8(a6),a2
move.l 12(a6),a1
move.b 4(a1),d1
move.b d1,d4
move.b 4(a2),d2
eor.b d2,d4
bpl.b 1f
moveq #1,d0
tst.b d2
bpl.b 2f
moveq #-1,d0
2: bra.b cmpirf
1: tst.b d1
bne.b 3f
moveq #1,d0
tst.b d2
bne.b 4f
moveq #0,d0
4: bra.b cmpirf
3: move.w 2(a1),d0
bsr _getr
move.l a0,a3
move.l a0,-(sp)
move.l a2,-(sp)
bsr _affir
addq.l #8,sp
move.l a1,-(sp)
move.l a0,-(sp)
bsr _cmprr
addq.l #8,sp
move.l a3,a0
bsr _giv
cmpirf: movem.l (sp)+,d1-d4/a0-a3
unlk a6
rts
*===================================================================*
* *
* Comparaison : reel et entier court *
* *
* entree : a7(4) pointe sur r2 de type R *
* a7(8) contient s1 *
* sortie : d0.l contient le signe de r2 - s1 *
* aucun autre registre n'est affecte *
* *
*===================================================================*
_cmprs: move.l 4(sp),-(sp)
move.l 12(sp),-(sp)
bsr _cmpsr
addq.l #8,sp
neg.l d0
rts
*===================================================================*
* *
* Comparaison : reel et entier *
* *
* entree : a7(4) pointe sur r2 de type R *
* a7(8) contient i1 *
* sortie : d0.l contient le signe de r2 - i1 *
* aucun autre registre n'est affecte *
* *
*===================================================================*
_cmpri: move.l 4(sp),-(sp)
move.l 12(sp),-(sp)
bsr _cmpir
addq.l #8,sp
neg.l d0
rts
*===================================================================*
* *
* Comparaison : reel et reel *
* *
* entree : a7(4) pointe sur r2 de type R *
* a7(8) pointe sur r1 de type R *
* sortie : d0.l contient :1 si r2>r1,0 si r2=r1,-1 sinon *
* d1,a0,a1 sont sauvegardes *
* *
*===================================================================*
_cmprr: link a6,#0
movem.l d1-d5/a1-a2,-(sp)
move.l 8(a6),a2
move.l 12(a6),a1
move.b 4(a1),d1
move.b d1,d4
move.b 4(a2),d2
eor.b d2,d4
bpl.b 1f
moveq #1,d0
tst.b d2
bpl.b 2f
moveq #-1,d0
2: bra.b cmprrf
1: tst.b d1
bne.b 3f
moveq #1,d0
tst.b d2
bne.b 4f
moveq #0,d0
4: bra.b cmprrf
3: tst.b 4(a2)
bne.b 5f
moveq #-1,d0
bra.b cmprrf
5: moveq #1,d0
move.w 2(a1),d1
move.w 2(a2),d2
cmp.w d1,d2
bpl.b 6f
exg d1,d2
exg a1,a2
moveq #-1,d0
6: tst.b 4(a2)
bpl.b 7f
neg.l d0
7: move.l 4(a1),d5
and.l #0xffffff,d5
move.l 4(a2),d3
and.l #0xffffff,d3
cmp.l d5,d3
bpl.b 8f
L1004: neg.l d0
bra.b cmprrf
8: bne.b cmprrf
sub.w d1,d2
subq.w #3,d1
addq.l #8,a1
addq.l #8,a2
9: cmpm.l (a1)+,(a2)+
dbne d1,9b
bcs.b L1004
beq.b L1105
bra.b cmprrf
L1202: tst.l (a2)+
L1105: dbne d2,L1202
bne.b cmprrf
moveq #0,d0
cmprrf: movem.l (sp)+,d1-d5/a1-a2
unlk a6
rts
*********************************************************************
*********************************************************************
*** ***
*** PROGRAMMES D'ADDITION ***
*** ***
*********************************************************************
*********************************************************************
*===================================================================*
* *
* Addition generale *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* a7(8) pointe sur n1 de type I ou R *
* sortie : d0 pointe sur n2 + n1 de type I ou R (zone creee) *
* interdit : type S *
* precision : voir les formules des routines specalisees *
* *
*===================================================================*
_mpadd: move.l 4(sp),a0
move.l 8(sp),a1
move.b (a0),d0
move.b (a1),d1
cmp.b d1,d0
ble.b 1f
exg a1,a0
exg d1,d0
move.l a0,4(sp)
move.l a1,8(sp)
1: cmp.b #1,d1
beq.w _addii
2: cmp.b #2,d0
beq.w _addrr
bra.w _addir
*===================================================================*
* *
* Addition (par valeur) *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* a7(8) pointe sur n1 de type I ou R *
* a7(12) pointe sur n3 de type I ou R *
* sortie : la zone pointee par a7(12) contient n2+n1 *
* interdit : type S *
* *
*===================================================================*
_mpaddz: lea _mpadd,a0
bra.w mpopz
_addssz: lea _addss,a0
bra.w mpopz
_addsiz: lea _addsi,a0
bra.w mpopz
_addsrz: lea _addsr,a0
bra.w mpopz
_addiiz: lea _addii,a0
bra.w mpopz
_addirz: lea _addir,a0
bra.w mpopz
_addrrz: lea _addrr,a0
bra.w mpopz
*===================================================================*
* *
* Addition : entier court + entier court = entier *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) contient s1 de type S *
* sortie : d0 pointe sur s1+s2 de type I(zone cree) *
* remarque : s1 + s2 = s0 est interdit *
* *
*===================================================================*
_addss: link a6,#-2
move.l d2,-(sp)
move.l 8(a6),d1
move.l 12(a6),d2
add.l d2,d1
bne.b 1f
bvs.b 2f
move.l _gzero,d0
bra.b addssg
2: move.w #4,d0
bsr _geti
move.l #0xff000004,4(a0)
move.l #1,8(a0)
clr.l 12(a0)
bra.b addssf
1: move.w #3,d0
bsr _geti
move.l #0x1000003,4(a0)
add.l 8(a6),d2
bvs.b 3f
bmi.b 4f
bra.b 5f
3: bcc.b 5f
4: neg.l d1
move.b #0xff,4(a0)
5: move.l d1,8(a0)
addssf: move.l a0,d0
addssg: move.l (sp),d2
unlk a6
rts
*===================================================================*
* *
* Addition : entier court + entier = entier *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) pointe sur i1 de type I *
* sortie : d0 pointe sur s2 + i1 de type I (zone creee) *
* *
*===================================================================*
_addsi: link a6,#0
movem.l d2-d4/a2,-(sp)
move.l 12(a6),a1
move.l 8(a6),d2
bne.b 1f
move.w 6(a1),d0
bsr _geti
move.l a0,d4
subq.w #2,d0
addq.l #4,a0
addq.l #4,a1
2: move.l (a1)+,(a0)+
dbra d0,2b
bra.w addsif
1: tst.b 4(a1)
bne.b 3f
moveq #3,d0
bsr _geti
move.l a0,d4
move.l #0x1000003,4(a0)
move.l d2,8(a0)
bpl.w addsif
move.b #0xff,4(a0)
neg.l 8(a0)
bra.b addsif
3: move.w 6(a1),d0
bsr _geti
move.l a0,d4
move.w 4(a1),d1
ext.l d1
lea (a0,d0.w*4),a0
lea (a1,d0.w*4),a2
moveq #0,d3
subq.w #3,d0
eor.l d2,d1
bmi.b susi
tst.l d2
bpl.b L51
neg.l d2
L51: add.l -(a2),d2
bra.b 4f
5: move.l d2,-(a0)
move.l -(a2),d2
addx.l d3,d2
4: dbra d0,5b
bcc.b 6f
move.l d2,-(a0)
moveq #1,d0
bsr _geti
move.l a0,d4
move.l 4(a0),(a0)
addq.w #1,2(a0)
cmp.w #0x7fff,2(a0)
bls.b 7f
move.l #12,-(sp)
jsr _err
7: move.w 2(a0),6(a0)
move.l #1,8(a0)
bra.b 8f
6: move.l d2,-(a0)
subq.w #8,a0
move.w 2(a0),6(a0)
8: move.w 4(a1),4(a0)
move.l a0,d4
addsif: move.l d4,d0
movem.l (sp)+,d2-d4/a2
unlk a6
rts
susi: move.l d2,d1
bpl.b 6f
neg.l d1
6: move.l -(a2),d2
sub.l d1,d2
bra.b 1f
2: move.l d2,-(a0)
move.l -(a2),d2
subx.l d3,d2
1: dbra d0,2b
bcc.b 3f
neg.l d2
move.l d2,-(a0)
subq.l #8,a0
move.w #3,6(a0)
move.b 4(a1),d2
neg.b d2
move.b d2,4(a0)
bra.b addsif
3: tst.l d2
beq.b 4f
move.l d2,-(a0)
move.l 4(a1),-(a0)
bra.b addsif
4: move.l 4(a1),-(a0)
subq.w #1,2(a0)
cmp.w #2,2(a0)
bne.b 5f
clr.b (a0)
5: move.l -8(a0),-(a0)
subq.w #1,2(a0)
move.l a0,d4
addq.l #4,_avma
bra.b addsif
*===================================================================*
* *
* Addition : entier + entier = entier *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) pointe sur i1 de type I *
* sortie : d0 pointe sur i2 + i1 de type I (zone creee) *
* *
*===================================================================*
_addii: link a6,#0
movem.l d2-d7/a2-a4,-(sp)
move.l 8(a6),a2
move.l 12(a6),a1
moveq #0,d2
moveq #0,d1
move.w 6(a2),d2
move.w 6(a1),d1
cmp.w d1,d2
bcc.b 1f
exg a1,a2
exg d1,d2
1: tst.b 4(a1)
bne.b 2f
move.w 6(a2),d0
bsr _geti
subq.w #2,d0
move.l a0,a1
addq.l #4,a1
addq.l #4,a2
3: move.l (a2)+,(a1)+
dbra d0,3b
bra.w addiif
2: move.b 4(a1),d3
move.b 4(a2),d4
eor.b d4,d3
bmi.w suii
move.w d2,d0
bsr _geti
lea (a0,d0.w*4),a0
lea (a2,d0.w*4),a2
lea (a1,d1.w*4),a1
sub.w d1,d2
subq.w #3,d1
moveq #0,d4
4: move.l -(a1),d0
move.l -(a2),d5
addx.l d5,d0
move.l d0,-(a0)
dbra d1,4b
roxr.w d4,d0
bra.b 5f
6: move.l -(a2),d0
addx.l d4,d0
move.l d0,-(a0)
roxr.w d4,d0
5: dbcc d2,6b
bcs.b 7f
bra.b 8f
9: move.l -(a2),-(a0)
8: dbra d2,9b
move.l -(a2),-(a0)
subq.l #4,a0
bra.b addiif
7: move.w -2(a2),d2
addq.w #1,d2
cmp.w #0x8000,d2
bcs.b L1005
move.l #13,-(sp)
jsr _err
L1005: moveq #1,d0
bsr _geti
move.l #1,8(a0)
move.l 4(a0),(a0)
move.w d2,2(a0)
move.l -(a2),4(a0)
move.w d2,6(a0)
addiif: move.l a0,d0
addiig: movem.l (sp)+,d2-d7/a2-a4
unlk a6
rts
suii: move.l a1,a3
move.l a2,a4
sub.w d1,d2
bne.b 1f
subq.w #3,d1
addq.l #8,a3
addq.l #8,a4
2: cmpm.l (a3)+,(a4)+
dbne d1,2b
bhi.b 1f
bne.b 3f
move.l _gzero,d0
bra.b addiig
3: exg a1,a2
1: move.w 6(a2),d0
bsr _geti
move.w 6(a1),d1
move.l a0,-(sp)
move.b 4(a2),d7
lea (a1,d1.w*4),a1
lea (a2,d0.w*4),a2
lea (a0,d0.w*4),a0
sub.l d3,d3
subq.w #3,d1
4: move.l -(a2),d0
move.l -(a1),d5
subx.l d5,d0
move.l d0,-(a0)
dbra d1,4b
roxr.w d3,d0
bra.b 5f
6: move.l -(a2),d5
subx.l d3,d5
move.l d5,-(a0)
roxr.w d3,d0
5: dbcc d2,6b
bra.b 7f
8: move.l -(a2),-(a0)
7: dbra d2,8b
move.l (sp)+,a0
move.w 2(a0),d1
moveq #0,d2
move.w d1,d2
addq.l #8,a0
9: tst.l (a0)+
dbne d1,9b
subq.l #4,a0
move.l d1,-(a0)
move.b d7,(a0)
move.w d1,-(a0)
move.w #0x101,-(a0)
sub.w d1,d2
lsl.l #2,d2
add.l d2,_avma
bra.w addiif
*===================================================================*
* *
* Addition : entier court + reel = reel *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) pointe sur r1 de type R *
* sortie : d0 pointe sur s2 + r1 de type R (zone creee) *
* *
*===================================================================*
_addsr: link a6,#-12
move.l 8(a6),d1
bne.b 1f
move.l #0x1000002,-12(a6)
move.l #2,-8(a6)
bra.b 3f
1: bmi.b 2f
move.l #0x1000003,-12(a6)
move.l #0x1000003,-8(a6)
move.l d1,-4(a6)
bra.b 3f
2: move.l #0x1000003,-12(a6)
move.l #0xff000003,-8(a6)
neg.l d1
move.l d1,-4(a6)
3: move.l 12(a6),-(sp)
pea -12(a6)
bsr _addir
unlk a6
rts
*===================================================================*
* *
* Addition : entier + reel = reel *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) pointe sur r1 de type R *
* sortie : d0 pointe sur i2 + r1 de type R (zone creee) *
* precision : si exp2>=exp1 , L = L1 + int((exp2-exp1)/32) + 1*
* si exp2<exp1 , L = L1 *
* i2 est transforme en un reel *
* *
*===================================================================*
_addir: link a6,#-4
movem.l d2-d3/a2,-(sp)
move.l 8(a6),a2
move.l 12(a6),a1
tst.b 4(a2)
bne.b 1f
6: move.w 2(a1),d0
bsr _getr
move.l a0,-4(a6)
addq.l #4,a1
addq.l #4,a0
subq.w #2,d0
4: move.l (a1)+,(a0)+
dbra d0,4b
bra.w addirf
1: tst.b 4(a1)
bne.b 3f
move.l 4(a1),d1
sub.l #0x800000,d1
asr.l #5,d1
moveq #0,d0
move.w 6(a2),d0
sub.l d1,d0
cmp.l #3,d0
bcs.w 2f
cmp.l #0x8000,d0
bcc.w 2f
bsr _getr
move.l a0,-4(a6)
move.l a0,-(sp)
move.l a2,-(sp)
bsr _affir
addq.l #8,sp
bra.w addirf
3: move.l 8(a2),d0
bfffo d0{0:32},d1
moveq #0,d0
move.w 6(a2),d0
subq.w #2,d0
lsl.l #5,d0
sub.l d1,d0
subq.l #1,d0
moveq #0,d3
move.w 2(a1),d3
move.l 4(a1),d2
and.l #0xffffff,d2
sub.l #0x800000,d2
sub.l d0,d2
ble.b 5f
lsr.l #5,d2
sub.l d2,d3
cmp.l #2,d3
ble.w 6b
7: move.l _avma,-(sp)
move.w d3,d0
bsr _getr
move.l a0,-(sp)
move.l a2,-(sp)
bsr _affir
move.l a1,(sp)
bsr _addrr
move.l d0,a0
move.w 2(a0),d0
subq.w #1,d0
move.l 4(sp),a1
addq.l #8,sp
moveq #0,d1
move.w 2(a1),d1
lsl.l #2,d1
move.l (sp)+,a0
8: move.l -(a1),-(a0)
dbra d0,8b
add.l d1,_avma
move.l a0,-4(a6)
bra.b addirf
5: neg.l d2
lsr.l #5,d2
add.w d2,d3
addq.w #1,d3
cmp.w #0x8000,d3
bcs.b 7b
2: move.l #14,-(sp)
jsr _err
addirf: move.l -4(a6),d0
movem.l (sp)+,d2-d3/a2
unlk a6
rts
*===================================================================*
* *
* Addition : reel + reel = reel *
* *
* entree : a7(4) pointe sur r2 de type R *
* a7(8) pointe sur r1 de type R *
* sortie : d0 pointe sur r2 + r1 de type R (zone creee) *
* precision : L = inf ( L2 , L1 + [(exp2-exp1)/32]) *
* si exp2 >= exp1 (sinon echanger r1 et r2) *
* *
*===================================================================*
_addrr: link a6,#-16
movem.l d2-d7/a2-a4,-(sp)
move.l 8(a6),a2
move.l 12(a6),a1
tst.b 4(a2)
bne.w 1f
4: tst.b 4(a1)
bne.b L22
move.l 4(a1),d1
cmp.l 4(a2),d1
bgt.b L23
move.l 4(a2),d1
L23: moveq #3,d0
bsr _getr
move.l a0,-8(a6)
move.l d1,4(a0)
clr.l 8(a0)
bra.w addrrf
L22: moveq #0,d0
move.l 4(a2),d2
move.l 4(a1),d1
and.l #0xffffff,d1
sub.l d2,d1
bcc.b L24
moveq #3,d0
bsr _getr
move.l a0,-8(a6)
move.l 4(a2),4(a0)
clr.l 8(a0)
bra.w addrrf
L24: lsr.l #5,d1
move.w 2(a1),d0
subq.w #2,d0
cmp.l d1,d0
ble.b L25
move.l d1,d0
addq.l #1,d0
L25: addq.l #2,d0
bsr _getr
move.l a0,-8(a6)
addq.l #4,a1
addq.l #4,a0
subq.w #2,d0
L27: move.l (a1)+,(a0)+
dbra d0,L27
bra.w addrrf
1: tst.b 4(a1)
bne.b 3f
exg a2,a1
bra.b L22
3: move.b 4(a1),d3
move.b 4(a2),d5
eor.b d5,d3
move.b d3,-2(a6)
move.l 4(a2),d3
and.l #0xffffff,d3
move.l 4(a1),d1
and.l #0xffffff,d1
sub.l d1,d3
beq.w 5f
bcc.b 6f
exg a1,a2
neg.l d3
6: move.w d3,d4
and.w #31,d4
lsr.l #5,d3
moveq #0,d2
move.w 2(a2),d2
subq.w #2,d2
cmp.l d2,d3
bcs.b 7f
move.w 2(a2),d0
bsr _getr
move.l a0,-8(a6)
addq.l #4,a2
addq.l #4,a0
subq.w #2,d0
L28: move.l (a2)+,(a0)+
dbra d0,L28
bra.w addrrf
7: moveq #0,d1
move.w 2(a1),d1
subq.w #2,d1
move.l d3,d5
add.l d1,d5
cmp.l d2,d5
bcs.b 8f
move.b #1,-4(a6)
move.w d2,d0
addq.w #2,d0
bsr _getr
move.l a0,-8(a6)
move.w d2,d5
sub.w d3,d5
move.w d5,d0
addq.w #1,d0
bsr _getr
subq.w #2,d0
move.w 2(a2),d1
lea (a2,d1.w*4),a2
bra.b 9f
8: clr.b -4(a6)
move.w d5,d0
addq.w #3,d0
bsr _getr
move.l a0,-8(a6)
lea (a2,d0.w*4),a2
move.w 2(a1),d5
move.w d5,d0
subq.w #2,d5
bsr _getr
subq.w #3,d0
9: move.l a0,-12(a6)
addq.l #4,a0
move.l a0,a3
addq.l #8,a1
L29: move.l (a1)+,(a0)+
dbra d0,L29
tst.w d4
bne.b L1006
moveq #0,d7
move.w -2(a3),d7
subq.w #1,d7
move.w d7,d2
subq.w #1,d2
lea (a3,d7.w*4),a3
move.l a3,a1
bra.b L1106
L1006: subq.w #1,d5
move.w d5,d2
move.l #-1,d6
lsr.l d4,d6
moveq #0,d0
L1203: move.l (a3),d7
ror.l d4,d7
move.l d7,d1
and.l d6,d1
sub.l d1,d7
add.l d1,d0
move.l d0,(a3)+
move.l d7,d0
dbra d5,L1203
move.l a3,a1
tst.b -4(a6)
bne.b L1106
move.l d0,(a1)+
addq.w #1,d2
L1106: move.l -8(a6),a0
moveq #0,d1
move.w 2(a0),d1
lea (a0,d1.w*4),a0
bra.b L1402
5: move.b #2,-4(a6)
move.l d1,-16(a6)
move.w 2(a1),d0
cmp.w 2(a2),d0
bcs.b L1502
move.w 2(a2),d0
L1502: bsr _getr
move.l a0,-8(a6)
moveq #0,d2
move.w d0,d2
move.l d2,d0
subq.w #3,d2
moveq #0,d3
move.l a2,a4
move.l a1,a3
lea (a0,d0.w*4),a0
lea (a1,d0.w*4),a1
lea (a2,d0.w*4),a2
L1402: sub.l d4,d4
tst.b -2(a6)
bne.w surr
L1602: move.l -(a1),d1
move.l -(a2),d5
addx.l d5,d1
move.l d1,-(a0)
dbra d2,L1602
roxr.w d4,d0
bcc.b L1702
bra.b L1802
L1902: move.l -(a2),d5
addx.l d4,d5
move.l d5,-(a0)
roxr.w d4,d0
L1802: dbcc d3,L1902
bcs.b L2002
bra.b L1702
L30: move.l -(a2),-(a0)
L1702: dbra d3,L30
move.l -(a2),-(a0)
cmp.b #2,-4(a6)
beq.b addrrf
move.l -12(a6),a0
bsr _giv
bra.b addrrf
L2002: move.l -(a2),d1
and.l #0xffffff,d1
addq.l #1,d1
cmp.l #0x1000000,d1
blt.b 2f
move.l #15,-(sp)
jsr _err
2: cmp.b #2,-4(a6)
beq.b L1303
move.l a0,a3
move.l -12(a6),a0
bsr _giv
move.l a3,a0
L1303: move.l d1,-4(a0)
move.b (a2),-4(a0)
move.w -6(a0),d2
subq.w #3,d2
move.w #-1,d0
move.w d0,ccr
L31: roxr.w (a0)+
roxr.w (a0)+
dbra d2,L31
addrrf: move.l -8(a6),d0
movem.l (sp)+,d2-d7/a2-a4
unlk a6
rts
surr: moveq #0,d6
move.w d2,d6
move.w d2,d7
add.w d3,d7
addq.w #3,d7
cmp.b #2,-4(a6)
bne.b 1f
addq.l #8,a3
addq.l #8,a4
L1204: cmpm.l (a3)+,(a4)+
dbne d2,L1204
bhi.b 1f
bne.b 2f
move.l -8(a6),a0
moveq #0,d2
move.w 2(a0),d2
subq.w #2,d2
lsl.l #5,d2
neg.l d2
add.l -16(a6),d2
bpl.b L1503
move.l #16,-(sp)
jsr _err
L1503: cmp.l #0x1000000,d2
blt.b L1603
move.l #15,-(sp)
jsr _err
L1603: bsr _giv
moveq #3,d0
bsr _getr
move.l a0,-8(a6)
move.l d2,4(a0)
clr.l 8(a0)
bra.b addrrf
2: exg a1,a2
1: sub.w d2,d6
sub.l d4,d4
3: move.l -(a2),d0
move.l -(a1),d5
subx.l d5,d0
move.l d0,-(a0)
dbra d2,3b
roxr.w d4,d0
bra.b 4f
5: move.l -(a2),d5
subx.l d4,d5
move.l d5,-(a0)
roxr.w d4,d0
4: dbcc d3,5b
bra.b 6f
L1304: move.l -(a2),-(a0)
6: dbra d3,L1304
moveq #0,d3
moveq #-1,d2
move.w d2,d3
L1403: tst.l (a0)+
dbne d2,L1403
sub.w d2,d3
add.w d6,d3
sub.l #12,a0
move.l a0,-8(a6)
move.l a0,a1
cmp.b #2,-4(a6)
beq.b 7f
move.l -12(a6),a0
bsr _giv
7: moveq #0,d0
move.w d3,d0
lsl.l #2,d0
add.l d0,_avma
move.l a1,a0
move.w #0x201,(a0)
sub.w d3,d7
move.w d7,2(a0)
lsl.l #5,d3
move.l 8(a0),d0
bfffo d0{0:32},d1
lsl.l d1,d0
add.l d1,d3
lsl.l #2,d6
sub.l d6,a2
move.l -4(a2),d2
and.l #0xffffff,d2
sub.l d3,d2
move.l d2,4(a0)
move.b -4(a2),4(a0)
tst.b d1
bne.b 8f
bra.b 9f
8: moveq #1,d6
lsl.l d1,d6
subq.l #1,d6
addq.l #8,a1
subq.w #3,d7
bra.b L1007
L1107: move.l 4(a1),d2
rol.l d1,d2
move.l d2,d3
and.l d6,d3
sub.l d3,d2
add.l d3,d0
move.l d0,(a1)+
move.l d2,d0
L1007: dbra d7,L1107
move.l d0,(a1)
9: bra.w addrrf
*********************************************************************
*********************************************************************
*** ***
*** PROGRAMMES DE SOUSTRACTION ***
*** ***
*********************************************************************
*********************************************************************
*===================================================================*
* *
* Soustraction generale *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* a7(8) pointe sur n1 de type I ou R *
* sortie : d0 pointe sur n2 - n1 de type I ou R (zone creee) *
* interdit : type S *
* *
*===================================================================*
_mpsub: cmp.b #1,([8,sp])
bne.b 1f
cmp.b #1,([4,sp])
beq.w _subii
bra.w _subri
1: cmp.b #1,([4,sp])
beq.w _subir
bra.w _subrr
*===================================================================*
* *
* Soustraction (par valeur) *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* a7(8) pointe sur n1 de type I ou R *
* a7(12) pointe sur n3 de type I ou R *
* sortie : la zone pointee par a7(12) contient n2 - n1 *
* interdit : type S *
* *
*===================================================================*
_mpsubz: lea _mpsub,a0
bra.w mpopz
_subssz: lea _subss,a0
bra.w mpopz
_subsiz: lea _subsi,a0
bra.w mpopz
_subsrz: lea _subsr,a0
bra.w mpopz
_subisz: lea _subis,a0
bra.w mpopz
_subiiz: lea _subii,a0
bra.w mpopz
_subirz: lea _subir,a0
bra.w mpopz
_subrsz: lea _subrs,a0
bra.w mpopz
_subriz: lea _subri,a0
bra.w mpopz
_subrrz: lea _subrr,a0
bra.w mpopz
*===================================================================*
* *
* Soustraction : entier court - entier court = entier *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) contient s1 de type S *
* sortie : d0 pointe sur s2 - s1 de type I (zone creee) *
* remarque : s2 - s1 = s0 est interdit *
* *
*===================================================================*
_subss: link a6,#-12
move.l 12(a6),d1
neg.l d1
bvs.b 1f
move.l d1,-(sp)
move.l 8(a6),-(sp)
bsr _addss
bra.b subssf
1: move.l #0x1000003,-12(a6)
move.l #0x1000003,-8(a6)
move.l #0x80000000,-4(a6)
pea -12(a6)
move.l 8(a6),-(sp)
bsr _addsi
subssf: unlk a6
rts
*===================================================================*
* *
* Soustraction : entier - entier = entier *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) pointe sur i1 de type I *
* sortie : d0 pointe sur i2 - i1 de type I (zone creee) *
* *
*===================================================================*
_subii: link a6,#-4
move.l 12(a6),-(sp)
move.l 8(a6),-(sp)
move.l 12(a6),a0
neg.b 4(a0)
move.l a0,-4(a6)
bsr _addii
move.l -4(a6),a0
neg.b 4(a0)
unlk a6
rts
*===================================================================*
* *
* Soustraction : reel - reel = reel *
* *
* entree : a7(4) pointe sur r2 de type R *
* a7(8) pointe sur r1 de type R *
* sortie : d0 pointe sur r2 - r1 de type R (zone creee) *
* *
*===================================================================*
_subrr: link a6,#-4
move.l 12(a6),-(sp)
move.l 8(a6),-(sp)
move.l 12(a6),a0
neg.b 4(a0)
move.l a0,-4(a6)
bsr _addrr
move.l -4(a6),a0
neg.b 4(a0)
unlk a6
rts
*===================================================================*
* *
* Soustraction : entier court - entier = entier *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) pointe sur i1 de type I *
* sortie : d0 pointe sur s2 - i1 de type I *
* *
*===================================================================*
_subsi: link a6,#-4
move.l 12(a6),-(sp)
move.l 8(a6),-(sp)
move.l 12(a6),a0
neg.b 4(a0)
move.l a0,-4(a6)
bsr _addsi
move.l -4(a6),a0
neg.b 4(a0)
unlk a6
rts
*===================================================================*
* #
* Soustraction : entier court - reel = reel *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) pointe sur r1 de type R *
* sortie : d0 pointe sur s2 - r1 de type R (zone creee) *
* *
*===================================================================*
_subsr: link a6,#-4
move.l 12(a6),-(sp)
move.l 8(a6),-(sp)
move.l 12(a6),a0
neg.b 4(a0)
move.l a0,-4(a6)
bsr _addsr
move.l -4(a6),a0
neg.b 4(a0)
unlk a6
rts
*===================================================================*
* *
* Soustraction : entier - entier court = entier *
* *
* entree : a7(4) pointe sur i1 de type I *
* a7(8) contient s2 de type S *
* sortie : d0 pointe sur i1 - s2 de type I (zone creee) *
* *
*===================================================================*
_subis: link a6,#-12
move.l 8(a6),-(sp)
move.l 12(a6),d1
neg.l d1
bvs.b 1f
move.l d1,-(sp)
bsr _addsi
bra.b subisf
1: move.l #0x1000003,-12(a6)
move.l #0x1000003,-8(a6)
move.l #0x80000000,-4(a6)
pea -12(a6)
bsr _addii
subisf: unlk a6
rts
*===================================================================*
* *
* Soustraction : entier - reel = reel *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) pointe sur r1 de type R *
* sortie : d0 pointe sur i2 - r1 de type R (zone creee) *
* *
*===================================================================*
_subir: link a6,#-4
move.l 12(a6),-(sp)
move.l 8(a6),-(sp)
move.l 12(a6),a0
neg.b 4(a0)
move.l a0,-4(a6)
bsr _addir
move.l -4(a6),a0
neg.b 4(a0)
unlk a6
rts
*===================================================================*
* *
* Soustraction : reel - entier = reel *
* *
* entree : a7(4) pointe sur r1 de type R *
* a7(8) pointe sur i2 de type I *
* sortie : d0 pointe sur r2 - i1 de type R (zone creee) *
* *
*===================================================================*
_subri: link a6,#-4
move.l 8(a6),-(sp)
move.l 12(a6),-(sp)
move.l 12(a6),a0
neg.b 4(a0)
move.l a0,-4(a6)
bsr _addir
move.l -4(a6),a0
neg.b 4(a0)
unlk a6
rts
*===================================================================*
* *
* Soustraction : reel - entier court = reel *
* *
* entree : a7(4) pointe sur r2 de type R *
* a7(8) contient s1 de type S *
* sortie : d0 pointe sur r2 - s1 de type R (zone creee) *
* *
*===================================================================*
_subrs: link a6,#-12
move.l 8(a6),-(sp)
move.l 12(a6),d1
neg.l d1
bvs.b 1f
move.l d1,-(sp)
bsr _addsr
bra.b subsrf
1: move.l #0x1000003,-12(a6)
move.l #0x1000003,-8(a6)
move.l #0x80000000,-4(a6)
pea -12(a6)
bsr _addir
subsrf: unlk a6
rts
*********************************************************************
*********************************************************************
*** ***
*** PROGRAMMES DE MULTIPLICATION ***
*** ***
*********************************************************************
*********************************************************************
*===================================================================*
* *
* Multiplication generale *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* a7(8) pointe sur n1 de type I ou R *
* sortie : d0 pointe sur n2 * n1 de type I ou R (zone cree) *
* interdit : type S *
* precision : voir routines specialisees *
* *
*===================================================================*
_mpmul: move.l 4(sp),a0
move.l 8(sp),a1
move.b (a0),d0
move.b (a1),d1
cmp.b d1,d0
ble.b 1f
exg a1,a0
exg d1,d0
move.l a0,4(sp)
move.l a1,8(sp)
1: cmp.b #1,d1
beq.w _mulii
2: cmp.b #2,d0
beq.w _mulrr
bra.w _mulir
*===================================================================*
* *
* Multiplication (par valeur) *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* a7(8) pointe sur n1 de type I ou R *
* a7(12) pointe sur n3 de type I ou R *
* sortie : la zone pointee par a7(12) contient n2*n1 *
* interdit : type S *
* *
*===================================================================*
_mpmulz: lea _mpmul,a0
bra.w mpopz
_mulssz: lea _mulss,a0
bra.w mpopz
_mulsiz: lea _mulsi,a0
bra.w mpopz
_mulsrz: lea _mulsr,a0
bra.w mpopz
_muliiz: lea _mulii,a0
bra.w mpopz
_mulirz: lea _mulir,a0
bra.w mpopz
_mulrrz: lea _mulrr,a0
bra.w mpopz
*===================================================================*
* *
* Multiplication : entier court * entier court = entier *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) contient s1 de type S *
* sortie : d0 pointe sur s2 * s1 de type I (zone creee) *
* *
*===================================================================*
_mulss: link a6,#-2
movem.l d2-d4,-(sp)
move.l 8(a6),d2
bne.b 1f
2: move.l _gzero,d0
bra.b mulssg
1: move.l d2,d4
bpl.b 3f
neg.l d2
3: move.l 12(a6),d1
beq.b 2b
eor.l d1,d4
tst.l d1
bpl.b 4f
neg.l d1
4: mulu.l d1,d3:d2
move.w #4,d0
tst.l d3
bne.b 5f
move.w #3,d0
5: bsr _geti
move.w 2(a0),6(a0)
move.b #1,4(a0)
tst.l d4
bpl.b 6f
neg.b 4(a0)
6: tst.l d3
bne.b 7f
move.l d2,8(a0)
bra.b mulssf
7: move.l d3,8(a0)
move.l d2,12(a0)
mulssf: move.l a0,d0
mulssg: movem.l (sp)+,d2-d4
unlk a6
rts
_mulmodll: move.l 4(sp),d1
mulu.l 8(sp),d0:d1
divu.l 12(sp),d0:d1
rts
*===================================================================*
* *
* Multiplication : entier court * entier = entier *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) pointe sur i1 de type I *
* sortie : d0 pointe sur s2 * i1 de type I (zone creee) *
* *
*===================================================================*
_mulsi: link a6,#0
movem.l d2-d6/a2,-(sp)
move.l 8(a6),d2
bne.b 1f
2: move.l _gzero,d0
bra.b mulsig
1: bpl.b 6f
neg.l d2
6: move.l 12(a6),a1
tst.b 4(a1)
beq.b 2b
move.w 6(a1),d0
bsr _geti
lea (a0,d0.w*4),a2
lea (a1,d0.w*4),a1
subq.w #3,d0
moveq #0,d6
moveq #0,d5
3: move.l -(a1),d4
mulu.l d2,d3:d4
add.l d5,d4
addx.l d6,d3
move.l d4,-(a2)
move.l d3,d5
dbra d0,3b
beq.b 5f
move.w #1,d0
bsr _geti
move.w 6(a0),d0
addq.w #1,d0
bvc.b 4f
move.l #19,-(sp)
jsr _err
4: move.w d0,2(a0)
move.l d5,8(a0)
5: move.w 2(a0),6(a0)
move.b -4(a1),4(a0)
tst.l 8(a6)
bpl.b mulsif
neg.b 4(a0)
mulsif: move.l a0,d0
mulsig: movem.l (sp)+,d2-d6/a2
unlk a6
rts
*===================================================================*
* *
* Multiplication : entier court * reel = reel *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) pointe sur r1 de type R *
* sortie : d0 pointe sur s2 * r1 de type R *
* de longueur L = L1 (zone creee) *
* *
*===================================================================*
_mulsr: link a6,#-4
movem.l d2-d6/a2,-(sp)
move.l 8(a6),d2
bne.b 1f
move.l _gzero,d0
bra.w mulsrf1
1: move.l 12(a6),a1
tst.b 4(a1)
bne.b 2f
moveq #3,d0
bsr _getr
tst.l d2
bpl.b 2f
neg.l d2
bfffo d2{0:32},d0
move.l 4(a1),d1
add.l #31,d1
sub.l d0,d1
cmp.l #0x1000000,d1
bcc.w L1108
move.l d1,4(a0)
clr.l 8(a0)
move.l a0,d0
bra.w mulsrf1
2: move.w 2(a1),d0
bsr _getr
move.l a0,-4(a6)
move.l d2,d4
bpl.b 3f
neg.l d2
3: cmp.l #1,d2
bne.b 4f
addq.l #4,a0
addq.l #4,a1
subq.w #2,d0
5: move.l (a1)+,(a0)+
dbra d0,5b
move.l -4(a6),a0
tst.l d4
bpl.w mulsrf
neg.b 4(a0)
bra.w mulsrf
4: move.b 4(a1),4(a0)
tst.l d4
bpl.b 6f
neg.b 4(a0)
6: lea (a0,d0.w*4),a0
lea (a1,d0.w*4),a1
subq.w #3,d0
move.w d0,d4
move.w d4,d6
moveq #0,d1
moveq #0,d0
7: move.l -(a1),d5
mulu.l d2,d3:d5
add.l d0,d5
addx.l d1,d3
move.l d5,-(a0)
move.l d3,d0
dbra d6,7b
bfffo d0{0:32},d1
lsl.l d1,d0
moveq #1,d6
lsl.l d1,d6
subq.l #1,d6
neg.b d1
add.b #32,d1
8: move.l (a0),d2
ror.l d1,d2
move.l d2,d3
and.l d6,d3
sub.l d3,d2
add.l d3,d0
move.l d0,(a0)+
move.l d2,d0
dbra d4,8b
move.l -4(a6),a0
move.l -4(a1),d0
and.l #0xffffff,d0
add.l d1,d0
btst #24,d0
beq.b 9f
L1108: move.l #18,-(sp)
jsr _err
9: move.w d0,6(a0)
swap d0
move.b d0,5(a0)
mulsrf: move.l -4(a6),d0
mulsrf1: movem.l (sp)+,d2-d6/a2
unlk a6
rts
*===================================================================*
* *
* Multiplication : entier * entier = entier *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) pointe sur i1 de type I *
* sortie : d0 pointe sur i2 * i1 de type I (zone creee) *
* *
*===================================================================*
_mulii: link a6,#0
movem.l d2-d7/a2-a4,-(sp)
move.l 8(a6),a1
move.l 12(a6),a2
move.w 6(a1),d1
move.w 6(a2),d2
cmp.w d1,d2
bcc.b 1f
exg a1,a2
exg d1,d2
1: subq.w #2,d1
bne.b 2f
6: move.l _gzero,d0
bra.w muliig
2: move.w d2,d0
add.w d1,d0
bvc.b 3f
move.l #17,-(sp)
jsr _err
bra.b 6b
3: bsr _geti
move.w d0,6(a0)
move.b 4(a1),d3
move.b 4(a2),d4
eor.b d4,d3
addq.b #1,d3
move.b d3,4(a0)
lea (a0,d0.w*4),a4
lea (8,a1,d1.w*4),a1
lea (a2,d2.w*4),a3
subq.w #1,d1
subq.w #3,d2
move.w d2,d0
moveq #0,d7
*; x=x1x2...xn multiplicande (x=i2,n=L2) pointe par a2 et a3 *
*; y=y1...ym multiplicateur (y=i1,m=L1) pointe par a1 *
*; z=z1z2...z(n+m) resultat pointe par a0 et a4 *
*; a0 et a2 sont decrementes par la boucle interne (les valeurs initiales *
*; etant conservees dans a4 et a3) *
*...................................................................*
move.l a3,a2
move.l a4,a0
move.l -(a1),d3
sub.l d4,d4
m1: move.l d4,d6
move.l d3,d5
mulu.l -(a2),d4:d5
addx.l d5,d6
addx.l d7,d4
move.l d6,-(a0)
dbra d2,m1
bra.b bclf
mext: subq.l #4,a4
move.l a3,a2
move.l a4,a0
move.l d0,d2
move.l -(a1),d3
sub.l d4,d4
mint: move.l d4,d6
move.l d3,d5
mulu.l -(a2),d4:d5
addx.l d5,d6
addx.l d7,d4
add.l d6,-(a0)
dbra d2,mint
addx.l d7,d4
bclf: move.l d4,-(a0)
dbra d1,mext
*...................................................................*
beq.b 4f
subq.l #8,a0
bra.b muliif
4: subq.w #1,-2(a0)
subq.w #1,-6(a0)
move.l -4(a0),(a0)
move.l -8(a0),-(a0)
add.l #4,_avma
muliif: move.l a0,d0
muliig: movem.l (sp)+,d2-d7/a2-a4
unlk a6
rts
*===================================================================*
* *
* Multiplication : reel * reel = reel *
* *
* entree : a7(4) pointe sur r2 de type R *
* a7(8) pointe sur r1 de type R *
* sortie : d0 pointe sur r2 * r1 de type R (zone creee) *
* *
* precision : L = inf ( L1 , L2 ) *
* *
*===================================================================*
_mulrr: link a6,#-20
movem.l d2-d7/a2-a4,-(sp)
move.l 8(a6),a1
move.l 12(a6),a2
move.b 4(a1),d0
and.b 4(a2),d0
bne.b munzr
muzr: moveq #3,d0
bsr _getr
move.l a0,-8(a6)
move.l 4(a1),d1
and.l #0xffffff,d1
move.l 4(a2),d2
and.l #0xffffff,d2
add.l d2,d1
sub.l #0x800000,d1
cmp.l #0x1000000,d1
bcs.b 1f
move.l #20,-(sp)
jsr _err
1: tst.l d1
bgt.b 2f
move.l #21,-(sp)
jsr _err
2: move.l d1,4(a0)
clr.l 8(a0)
bra.b mulrrf
munzr: move.w 2(a2),d0
clr.l -12(a6)
cmp.w 2(a1),d0
bls.b 1f
move.w 2(a1),d0
exg a1,a2
bra.b 2f
1: bne.b 2f
lea (a1,d0.w*4),a3
move.l a3,-12(a6)
move.l (a3),-16(a6)
clr.l (a3)
2: bsr _getr
move.l a0,-8(a6)
bsr murr
tst.l -12(a6)
beq.b mulrrf
move.l -12(a6),a1
move.l -16(a6),(a1)
mulrrf: move.l -8(a6),d0
movem.l (sp)+,d2-d7/a2-a4
unlk a6
rts
*-------------------------------------------------------------------*
* module interne de multiplication r0=r1*r2 *
* ( pour R*R et I*R) *
* entree : a1 et a2 pointent sur 2 reels *
* r1,r2 non nuls avec L1>=L2=m *
* a0 pointe sur une zone reelle de long l1 *
* sortie : le produit r0 est mis a l'addresse a0 *
* *
*-------------------------------------------------------------------*
*; notation : r1 = x = x1x2...xmx(m+1)... multiplicande *
* ; r2 = y = y1y2...ym multiplicateur *
* ; ( le lgmot x(m+1) peut ne pas exister ! ( le1 >= le2 = m ) ) *
* ; z = z0z1z2...zmz(m+1) resultat. *
* ; ( z0=0 ou 1 et z(m+1) a jeter) *
* move.w 2(a2),d0 doit avoir ete fait avant l'appel *
murr: move.l a1,a3
lea 12(a3),a3
lea (a2,d0.w*4),a2
lea (a0,d0.w*4),a0
move.l (a0),-4(a6)
clr.l (a0)+
subq.w #3,d0
move.l d0,-20(a6)
clr.w d3
*...................................................................*
bext: move.l a0,a4
move.l a3,a1
move.w d3,d2
move.l -(a2),d4
move.l (a3)+,d5
sub.l d1,d1
mulu.l d4,d7:d5
bint: move.l d7,d6
move.l d4,d5
mulu.l -(a1),d7:d5
addx.l d5,d6
addx.l d1,d7
add.l d6,-(a4)
dbra d2,bint
addx.l d1,d7
move.l d7,-(a4)
addq.w #1,d3
dbra d0,bext
*...................................................................*
move.l -4(a1),d1
and.l #0xffffff,d1
move.l -4(a2),d2
and.l #0xffffff,d2
add.l d2,d1
sub.l #0x800000,d1
tst.l (a4)
bpl.b 1f
add.l #1,d1
bra.b 2f
1: move.l a0,a4
subq.w #2,a4
move.l -20(a6),d0
roxl.w -(a4)
5: roxl.w -(a4)
roxl.w -(a4)
dbra d0,5b
2: cmp.l #0x1000000,d1
bcs.b 3f
move.l #20,-(sp)
jsr _err
3: tst.l d1
bgt.b 4f
move.l #21,-(sp)
jsr _err
4: move.l d1,-(a4)
move.b -4(a1),d1
move.b -4(a2),d2
eor.b d2,d1
addq.b #1,d1
move.b d1,(a4)
move.l -4(a6),-4(a0)
murrf: rts
*===================================================================*
* *
* Multiplication : entier * reel = reel *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) pointe sur r1 de type R *
* sortie : d0 pointeur sur i2 * r1 de type R (zone creee) *
* *
*===================================================================*
_mulir: link a6,#-20
movem.l d2-d7/a2-a4,-(sp)
move.l 8(a6),a2
tst.b 4(a2)
bne.b 1f
move.l _gzero,d0
bra.w mulirf1
1: move.l 12(a6),a1
tst.b 4(a1)
bne.b 2f
moveq #3,d0
bsr _getr
move.w 6(a2),d0
lsl.l #5,d0
bfffo 8(a2){0:32},d1
sub.l d1,d0
sub.l #65,d0
add.l 4(a1),d0
cmp.l #0x1000000,d0
bcs.b 3f
move.l #22,-(sp)
jsr _err
3: move.l d0,4(a0)
clr.l 8(a0)
move.l a0,d0
bra.b mulirf1
2: move.w 2(a1),d0
bsr _getr
move.l a0,-8(a6)
addq.w #1,d0
bsr _getr
move.l a0,-(a7)
move.l a2,-(a7)
bsr _affir
addq.l #4,sp
move.l (a7),a2
move.l -8(a6),a0
exg a1,a2
move.w 2(a2),d0
bsr murr
move.l (a7)+,a0
bsr _giv
mulirf: move.l -8(a6),d0
mulirf1: movem.l (sp)+,d2-d7/a2-a4
unlk a6
rts
*********************************************************************
*********************************************************************
*** ***
*** PROGRAMMES DE DIVISION AVEC RESTE ***
*** ***
*********************************************************************
*********************************************************************
*===================================================================*
* *
* Division avec reste (par valeur) *
* *
* entree : a7(4) pointe sur n2 de type I *
* a7(8) pointe sur n1 de type I *
* a7(12) pointe sur n3 de type I *
* a7(16) pointe sur n4 de type I *
* sortie : la zone pointee par a7(12) contient n2 / n1 *
* la zone pointee par a7(16) contient le reste (du *
* signe du dividende) *
* interdit : type S et R *
* *
*===================================================================*
_mpdvmdz: lea _dvmdii,a0
bra.w mpopii
_dvmdssz: lea _dvmdss,a0
bra.w mpopii
_dvmdsiz: lea _dvmdsi,a0
bra.w mpopii
_dvmdisz: lea _dvmdis,a0
bra.w mpopii
_dvmdiiz: lea _dvmdii,a0
bra.w mpopii
*===================================================================*
* *
*Division avec reste : entier court / entier court =(entier,entier) *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) contient s1 de type S *
* sortie : a7(12) pointe sur l'adresse du futur reste *
* d0 pointe sur s2 div s1 de type I *
* le reste est du signe de s2 (zone creee) *
* *
*===================================================================*
_dvmdss: link a6,#0
move.l d2,-(sp)
move.l 12(a6),-(sp)
move.l 8(a6),-(sp)
bsr _divss
dmd: addq.l #8,sp
tst.l d1
bne.b 1f
move.l _gzero,a0
bra.b dvmdssf
1: move.l d0,d2
moveq #3,d0
bsr _geti
move.l #0x1000003,4(a0)
tst.l d1
bpl.b 2f
neg.l d1
move.b #-1,4(a0)
2: move.l d1,8(a0)
move.l d2,d0
dvmdssf: move.l 16(a6),a1
move.l a0,(a1)
move.l (sp),d2
unlk a6
rts
*===================================================================*
* *
* Division avec reste : entier court / entier = (entier,entier) *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) pointe sur i1 de type I *
* a7(12) pointe sur l'adresse du futur reste *
* sortie : d0 pointe sur s2 div i1 de type I ; *
* reste du signe de s2 (zones creees) *
* *
*===================================================================*
_dvmdsi: move.l 8(a7),-(sp)
move.l 8(a7),-(sp)
bsr _divsi
dmdi: addq.l #8,sp
move.l d0,a1
tst.l d1
bne.b 1f
move.l _gzero,([12,sp])
rts
1: moveq #3,d0
bsr _geti
move.l #0x1000003,4(a0)
tst.l d1
bpl.b 2f
neg.l d1
move.b #-1,4(a0)
2: move.l d1,8(a0)
3: move.l a1,d0
move.l a0,([12,sp])
rts
*===================================================================*
* *
* Division avec reste : entier / entier court = (entier,entier) *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) contient s1 de type S *
* a7(12) pointe sur l'adresse du futur reste *
* sortie : d0 pointe sur i2 div s1 de type I *
* reste de type I du signe de s1 (zones creees) *
* *
*===================================================================*
_dvmdis: move.l 8(a7),-(sp)
move.l 8(a7),-(sp)
bsr _divis
bra.b dmdi
*===================================================================*
* *
* Division avec reste : entier / entier = (entier,entier) *
* *
* entree : a7(4) pointe sur i2 de type I (dividende) *
* a7(8) pointe sur i1 de type I (diviseur) *
* a7(12) contient un pointeur sur le reste si l'on *
* veut a la fois q et r, 0 si l'on ne veut que le *
* quotient, -1 si l'on ne veut que le reste *
* sortie : d0 pointe sur q si celui-ci est attendu, et sinon *
* sur r. a7(12) pointe sur r si q et r sont attendus*
* (toutes les zones sont creees) *
* remarque : il s'agit de la 'fausse division' ; le reste est *
* du signe du dividende *
* *
* *
* variable.bs locales (etat pile apres link): *
* -16 -14 -12 -10 -8 -6 -4 a6 4 8 12 16 *
* +---+---+---+---+---+---+------+----+----+----+----+----+ *
* n-m k sgnq sgnr n m ad(q,r) ret i2 i1 ^r/0/-1 *
* *
*===================================================================*
_dvmdii: link a6,#-32
movem.l d2-d7/a2-a4,-(sp)
move.l 12(a6),a1
move.w 6(a1),d1
cmp.w #2,d1
bne.b dv1
move.l #36,-(sp)
dvmerr: jsr _err
dv1: move.l 8(a6),a2
move.w 6(a2),d2
cmp.w #2,d2
bne.b dv3
dv2: move.l 16(a6),d3
cmp.l #-1,d3
beq.b 1f
move.l _gzero,d0
1: tst.l d3
beq.w dvmiif
move.l _gzero,a0
btst #0,d3
bne.b 2f
move.l d3,a1
move.l a0,(a1)
bra.w dvmiif
2: move.l a0,d0
bra.w dvmiif
dv3: move.w d2,d0
sub.w d1,d0
bcc.b dv4
move.l 16(a6),d3
cmp.l #-1,d3
beq.b 1f
move.l _gzero,d0
1: tst.l d3
beq.w dvmiif
move.l d0,d1
move.w d2,d0
bsr _geti
move.l a0,a1
subq.w #2,d0
addq.l #4,a0
addq.l #4,a2
2: move.l (a2)+,(a0)+
dbra d0,2b
cmp.l #-1,d3
beq.b 3f
move.l d3,a0
move.l a1,(a0)
move.l d1,d0
bra.w dvmiif
3: move.l a1,d0
bra.w dvmiif
dv4: move.b 4(a1),d3
move.b 4(a2),d4
eor.b d4,d3
addq.b #1,d3
move.b d3,-12(a6)
move.b d4,-10(a6)
move.l _avma,-20(a6)
move.w d2,d0
bsr _geti
move.l a0,-4(a6)
subq.w #2,d1
subq.w #2,d2
move.w d1,-6(a6)
move.w d2,-8(a6)
move.w d2,-16(a6)
sub.w d1,-16(a6)
addq.l #8,a2
addq.l #8,a1
move.l (a1),d3
subq.w #1,d2
subq.w #1,d1
bne.b divlon
divsim: clr.l d4
1: move.l (a2)+,d5
divu.l d3,d4:d5
move.l d5,(a0)+
dbra d2,1b
move.l d4,(a0)
move.l a0,a2
clr.w -14(a6)
bra.w ranger
divlon: bfffo d3{0:32},d4
move.w d4,-14(a6)
bne.b 1f
move.l a0,a4
move.l #0,(a4)+
4: move.l (a2)+,(a4)+
dbra d2,4b
move.l a0,a2
lea (4,a1,d1.w*4),a3
bra.b nosh
1: lsl.l d4,d3
move.w -6(a6),d0
bsr _geti
moveq #1,d6
lsl.l d4,d6
subq.l #1,d6
move.l a0,a3
subq.w #1,d0
addq.l #4,a1
bra.b 3f
2: move.l (a1)+,d1
rol.l d4,d1
move.l d1,d5
and.l d6,d1
add.l d1,d3
move.l d3,(a3)+
sub.l d1,d5
move.l d5,d3
3: dbra d0,2b
move.l d3,(a3)+
move.l a0,a1
move.l -4(a6),a4
moveq #0,d3
move.w -8(a6),d0
subq.w #1,d0
5: move.l (a2)+,d1
rol.l d4,d1
move.l d1,d5
and.l d6,d1
add.l d1,d3
move.l d3,(a4)+
sub.l d1,d5
move.l d5,d3
dbra d0,5b
move.l d3,(a4)
move.l -4(a6),a2
nosh: move.w -6(a6),d6
lea (4,a2,d6.w*4),a4
subq.w #1,d6
move.w -16(a6),d7
*-------------------------------------------------------------------*
bclext: move.l (a1),d0
cmp.l (a2),d0
bne.b 1f
moveq #-1,d1
add.l 4(a2),d0
bcs.b 4f
move.l d0,d2
bra.b 2f
1: move.l (a2),d2
move.l 4(a2),d1
divu.l d0,d2:d1
2: move.l 4(a1),d3
mulu.l d1,d4:d3
sub.l 8(a2),d3
subx.l d2,d4
bls.b 4f
3: subq.l #1,d1
sub.l 4(a1),d3
subx.l d0,d4
bhi.b 3b
4: move.w d6,d0
move.l a3,a1
move.l a4,a2
moveq #0,d2
sub.l d3,d3
5: move.l -(a1),d5
mulu.l d1,d4:d5
addx.l d3,d5
addx.l d2,d4
sub.l d5,-(a2)
move.l d4,d3
dbra d0,5b
addx.l d2,d3
sub.l d3,-4(a2)
bcc.b 6f
subq.l #1,d1
move.w d6,d0
move.l a3,a1
move.l a4,a2
7: addx.l -(a1),-(a2)
dbra d0,7b
6: move.l d1,-4(a2)
addq.l #4,a4
dbra d7,bclext
*-------------------------------------------------------------------*
ranger: clr.l -28(a6)
clr.l -32(a6)
move.l _avma,-24(a6)
move.l -20(a6),d7
sub.l _avma,d7
move.l 16(a6),d3
cmp.l #-1,d3
beq.b rngres
move.l -4(a6),a0
move.w -16(a6),d0
move.w d0,d1
addq.w #2,d0
tst.l (a0)
beq.b 1f
addq.w #1,d0
1: bsr _geti
move.l a0,-28(a6)
add.l d7,-28(a6)
lea (a0,d0.w*4),a1
move.l a2,a3
2: move.l -(a3),-(a1)
dbra d1,2b
move.w d0,6(a0)
move.b -12(a6),4(a0)
cmp.w #2,d0
bne.b rngres
clr.b 4(a0)
rngres: tst.l d3
beq.b rendre
move.w -6(a6),d0
subq.w #1,d0
4: tst.l (a2)+
dbne d0,4b
bne.b 1f
move.w #2,d0
bsr _geti
move.l #2,4(a0)
add.l d7,a0
move.l a0,-32(a6)
bra.b rendre
1: subq.l #4,a2
move.w d0,d1
addq.w #3,d0
bsr _geti
move.l a0,-32(a6)
add.l d7,-32(a6)
move.b -10(a6),4(a0)
move.w d0,6(a0)
addq.l #8,a0
move.w -14(a6),d3
bne.b 2f
5: move.l (a2)+,(a0)+
dbra d1,5b
bra.b rendre
2: moveq #-1,d6
lsr.l d3,d6
moveq #0,d5
bset d3,d5
moveq #0,d2
cmp.l (a2),d5
bls.b 3f
move.l (a2)+,d2
ror.l d3,d2
subq.w #1,d0
subq.w #1,-2(a0)
3: move.l (a2)+,d5
ror.l d3,d5
move.l d5,d4
and.l d6,d4
add.l d4,d2
move.l d2,(a0)+
sub.l d4,d5
move.l d5,d2
dbra d1,3b
rendre: move.l -20(a6),a0
move.l -24(a6),a1
move.l a1,d0
sub.l _avma,d0
lsr.l #2,d0
subq.w #1,d0
1: move.l -(a1),-(a0)
dbra d0,1b
move.l a0,_avma
move.l -28(a6),d0
bne.b 2f
move.l -32(a6),d0
bra.b dvmiif
2: tst.l -32(a6)
beq.b dvmiif
move.l 16(a6),a1
move.l -32(a6),(a1)
dvmiif: movem.l (sp)+,d2-d7/a2-a4
unlk a6
rts
*===================================================================*
* *
* Divisibilite de i2 par i1 *
* *
* entree : a7(4) pointe sur n2 de type I *
* a7(8) pointe sur n1 de type I *
* a7(12) contient un pointeur ( pour quotient ) *
* sortie : d0 contient 1 si n1 divise n2 *
* 0 sinon
* a7(12) pointe sur n2 / n1 de type I (zone creee) *
* lorsque n1 divise n2, sinon n'est pas affecte. *
* *
*===================================================================*
_mpdivis: link a6,#-8
move.l _avma,-8(a6)
pea -4(a6)
move.l 12(a6),-(sp)
move.l 8(a6),-(sp)
bsr _dvmdii
lea 12(sp),sp
tst.b ([-4,a6],4)
beq.b 1f
moveq #0,d0
move.l -8(a6),_avma
bra.b 2f
1: move.l 16(a6),-(sp)
move.l d0,-(sp)
bsr _affii
moveq #1,d0
move.l -8(a6),_avma
2: unlk a6
rts
*===================================================================*
* *
* Flag de divisibilite de i2 par i1 *
* *
* entree : a7(4) pointe sur n2 de type I *
* a7(8) pointe sur n1 de type I *
* sortie : d0 contient 1 si n1 divise n2 *
* 0 sinon *
* *
*===================================================================*
_divise: move.l #-1,-(sp)
move.l 12(sp),-(sp)
move.l 12(sp),-(sp)
bsr _dvmdii
lea 12(sp),sp
move.l d0,a0
moveq #1,d0
tst.b 4(a0)
beq.w _giv
moveq #0,d0
bra.w _giv
*********************************************************************
*********************************************************************
*** ***
*** PROGRAMMES DE DIVISION ***
*** ***
*********************************************************************
*********************************************************************
*===================================================================*
* *
* Division generale *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* a7(8) pointe sur n1 de type I ou R *
* sortie : d0 pointe sur n2 / n1 de type I ou R (zone creee) *
* Le reste est du signe du dividende *
* interdit : type S *
* precision : voir routines specialisees *
* *
*===================================================================*
_mpdiv: cmp.b #1,([8,sp])
bne.b 1f
cmp.b #1,([4,sp])
beq.w _divii
bra.w _divri
1: cmp.b #1,([4,sp])
beq.w _divir
bra.w _divrr
*===================================================================*
* *
* Division (par valeur) *
* *
* entree : a7(4) pointe sur n2 de type I ou R *
* a7(8) pointe sur n1 de type I ou R *
* a7(12) pointe sur n3 de type I ou R *
* sortie : la zone pointee par a7(12) contient n2 / n1 de *
* type le type de n3 *
* interdit : type S ainsi que les divisions suivantes : *
* R/I=I , I/R=I ,R/R=I *
* *
*===================================================================*
_mpdivz: move.l a2,-(sp)
move.l _avma,-(sp)
move.l 12(sp),a1
move.l 16(sp),a0
move.l 20(sp),a2
cmp.b #1,(a2)
bne.b 1f
cmp.b #1,(a1)
beq.b 2f
3: move.l #35,-(sp)
jsr _err
2: cmp.b #1,(a0)
bne.b 3b
move.l a0,-(sp)
move.l a1,-(sp)
bsr _divii
move.l a2,4(sp)
move.l d0,(sp)
bsr _affii
addq.l #8,sp
bra.b divzf
1: move.l a0,-(sp)
cmp.b #1,(a0)
beq.b 4f
move.l a1,-(sp)
cmp.b #1,(a1)
beq.b 5f
bsr _divrr
bra.b 6f
5: bsr _divir
bra.b 6f
4: cmp.b #1,(a1)
beq.b 7f
move.l a1,-(sp)
bsr _divri
bra.b 6f
7: move.w 6(a1),d0
addq.w #1,d0
bsr _getr
move.l a0,-(sp)
move.l a1,-(sp)
bsr _affir
move.l 4(sp),(sp)
move.l a0,4(sp)
bsr _divrr
6: move.l a2,4(sp)
move.l d0,(sp)
bsr _affrr
addq.l #8,sp
divzf: move.l (sp)+,_avma
move.l (sp)+,a2
rts
_divsrz: lea _divsr,a0
bra.w mpopz
_divrsz: lea _divrs,a0
bra.w mpopz
_divirz: lea _divir,a0
bra.w mpopz
_divriz: lea _divri,a0
bra.w mpopz
_divrrz: lea _divrr,a0
bra.w mpopz
*===================================================================*
* *
* Division par valeur : entier / entier = entier ou reel *
* *
* entree : a7(4) contient i2 de type S *
* a7(8) contient i1 de type S *
* a7(12) pointe sur i3 ou r3 de type I ou R *
* sortie : a7(12) pointe sur i2 / i1 de type I ou R *
* *
*===================================================================*
_divssz: cmp.b #1,([12,sp])
bne.b _divssr
_divssi: move.l 8(sp),-(sp)
move.l 8(sp),-(sp)
bsr _divss
move.l 20(sp),4(sp)
move.l d0,(sp)
bsr _affii
move.l (sp),a0
addq.l #8,sp
bra.w _giv
_divssr: move.l _avma,-(sp)
move.w ([16,sp],2),d0
bsr _getr
move.l a0,-(sp)
move.l 12(sp),-(sp)
bsr _affsr
move.l 4(sp),(sp)
move.l 20(sp),4(sp)
bsr _divrs
move.l 24(sp),4(sp)
move.l d0,(sp)
bsr _affrr
addq.l #8,sp
move.l (sp)+,_avma
rts
*===================================================================*
* *
* Division par valeur : S / I = entier ou reel *
* *
* entree : a7(4) contien i2 de type S *
* a7(8) pointe sur i1 de type I *
* a7(12) pointe sur i3 ou r3 de type I ou R *
* sortie : a7(12) pointe sur i2 / i1 de type I ou R *
* *
*===================================================================*
_divsiz: link a6,#0
movem.l a2-a4,-(sp)
move.l 16(a6),a3
cmp.b #1,(a3)
bne.b _divsir
_divsii: move.l 12(a6),-(sp)
move.l 8(a6),-(sp)
bsr _divsi
move.l 16(a6),4(sp)
move.l d0,(sp)
bsr _affii
move.l (sp),a0
addq.l #8,sp
bsr _giv
divsizf: movem.l (sp)+,a2-a4
unlk a6
rts
_divsir: move.l _avma,a2
move.w 2(a3),d0
addq.w #1,d0
bsr _getr
move.l a0,a4
move.l a0,-(sp)
move.l 8(a6),-(sp)
bsr _affsr
addq.l #2,d0
bsr _getr
move.l a0,4(sp)
move.l 12(a6),(sp)
bsr _affir
move.l a4,(sp)
bsr _divrr
move.l a3,4(sp)
move.l d0,(sp)
bsr _affrr
addq.l #8,sp
move.l a2,_avma
bra.b divsizf
*===================================================================*
* *
* Division par valeur : I / S = entier ou reel *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) contient i1 de type S *
* a7(12) pointe sur i3 ou r3 de type I ou R *
* sortie : a7(12) pointe sur i2 / i1 de type I ou R *
* *
*===================================================================*
_divisz: cmp.b #1,([12,sp])
bne.b _divisr
_divisi: move.l 8(sp),-(sp)
move.l 8(sp),-(sp)
bsr _divis
move.l 20(sp),4(sp)
move.l d0,(sp)
bsr _affii
move.l (sp),a0
addq.l #8,sp
bra.w _giv
_divisr: move.l _avma,-(sp)
move.w ([16,sp],2),d0
bsr _getr
move.l a0,-(sp)
move.l 12(sp),-(sp)
bsr _affir
move.l 4(sp),(sp)
move.l 20(sp),4(sp)
bsr _divrs
move.l 24(sp),4(sp)
move.l d0,(sp)
bsr _affrr
addq.l #8,sp
move.l (sp)+,_avma
rts
*===================================================================*
* *
* Division par valeur : entier / entier = entier ou reel *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) pointe sur i1 de type I *
* a7(12) pointe sur i3 ou r3 de type I ou R *
* sortie : a7(12) pointe sur i2 / i1 de type I ou R *
* *
*===================================================================*
_diviiz: link a6,#0
movem.l a2-a4,-(sp)
move.l 16(a6),a3
cmp.b #1,(a3)
bne.b _diviir
_diviii: move.l 12(a6),-(sp)
move.l 8(a6),-(sp)
bsr _divii
move.l 16(a6),4(sp)
move.l d0,(sp)
bsr _affii
move.l (sp),a0
addq.l #8,sp
bsr _giv
diviizf: movem.l (sp)+,a2-a4
unlk a6
rts
_diviir: move.l _avma,a2
move.w 2(a3),d0
bsr _getr
move.l a0,a4
move.l a0,-(sp)
move.l 8(a6),-(sp)
bsr _affir
addq.l #2,d0
bsr _getr
move.l a0,4(sp)
move.l 12(a6),(sp)
bsr _affir
move.l a4,(sp)
bsr _divrr
move.l a3,4(sp)
move.l d0,(sp)
bsr _affrr
addq.l #8,sp
move.l a2,_avma
bra.b diviizf
*===================================================================*
* *
* Division : entier court / entier court = entier *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) contient s1 de type S *
* sortie : d0 pointe sur s2 div s1 de type I (zone creee) *
* d1.l contient le reste(du signe du dividende) *
* *
*===================================================================*
_divss: link a6,#0
movem.l d2-d3,-(sp)
moveq #0,d3
move.l 12(a6),d1
bne.b 1f
move.l #23,-(sp)
jsr _err
1: move.l 8(a6),d2
bpl.b 5f
moveq #-1,d3
5: divs.l d1,d3:d2
bne.b 2f
3: move.l _gzero,d0
move.l d3,d1
bra.b divssg
2: moveq #3,d0
bsr _geti
move.l #0x1000003,4(a0)
tst.l d2
bpl.b 4f
neg.l d2
move.b #-1,4(a0)
4: move.l d2,8(a0)
move.l d3,d1
divssf: move.l a0,d0
divssg: movem.l (sp)+,d2-d3
unlk a6
rts
*===================================================================*
* *
* Division : entier court / entier = entier *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) contient i1 de type I *
* sortie : d0 pointe sur s2 div i1 de type I (zone creee) *
* d1.l contient le reste (du signe du dividende) *
* *
*===================================================================*
_divsi: link a6,#0
movem.l d2-d4,-(sp)
move.l 12(a6),a1
tst.b 4(a1)
bne.b 1f
move.l #24,-(sp)
jsr _err
1: move.l 8(a6),d2
bne.b 3f
2: move.l _gzero,d0
moveq #0,d1
bra.b divsig
3: move.w 6(a1),d1
cmp.w #3,d1
beq.b 4f
6: move.l _gzero,d0
move.l d2,d1
bra.b divsig
4: move.l 8(a1),d1
move.l d2,d3
bpl.b 5f
neg.l d3
5: moveq #0,d4
divu.l d1,d4:d3
beq.b 6b
moveq #3,d0
bsr _geti
move.l d3,8(a0)
move.l 4(a1),4(a0)
tst.l d2
bpl.b 7f
move.b #-1,4(a0)
7: move.l d4,d1
tst.b 4(a1)
bpl.b divsif
neg.l d1
divsif: move.l a0,d0
divsig: movem.l (sp)+,d2-d4
unlk a6
rts
*===================================================================*
* *
* Division : entier court / reel = reel *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) pointe sur r1 de type R *
* sortie : d0 pointe sur s2 / r1 de type R (zone creee) *
* *
*===================================================================*
_divsr: link a6,#-32
movem.l d2/a2-a4,-(sp)
move.l 12(a6),a1
tst.b 4(a1)
bne.b 2f
move.l #25,-(sp)
jsr _err
2: tst.l 8(a6)
bne.b 1f
move.l _gzero,d0
bra.b divsrf
1: moveq #0,d0
move.w 2(a1),d0
bsr _getr
move.l 8(a6),d2
move.l a0,a4
addq.w #1,d0
bsr _getr
move.l a0,-(sp)
move.l d2,-(sp)
bsr _affsr
addq.l #4,sp
move.l a0,a2
move.l a4,a0
bsr dvrr
move.l (sp)+,a0
bsr _giv
move.l a4,d0
divsrf: movem.l (sp)+,d2/a2-a4
unlk a6
rts
*===================================================================*
* *
* Division : entier / entier court = entier *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) contient s1 de type S *
* sortie : d0 pointe sur i2 / s1 de type I (zone creee) *
* le reste est dans d1.l (du signe du dividende) *
* *
*===================================================================*
_divis: link a6,#0
movem.l d2-d6/a2,-(sp)
move.l 12(a6),d1
bne.b 1f
move.l #26,-(sp)
jsr _err
1: bpl.b 2f
neg.l d1
2: move.l 8(a6),a2
move.w 6(a2),d2
move.w 4(a2),d5
bne.b 4f
3: move.l _gzero,d0
moveq #0,d1
bra.b divisg
4: move.w d2,d0
addq.l #8,a2
move.l (a2)+,d4
moveq #0,d3
divu.l d1,d3:d4
bne.b 5f
subq.w #1,d0
cmp.w #2,d0
bne.b 5f
move.l _gzero,a0
bra.b L1008
5: bsr _geti
move.l a0,a1
move.w d0,6(a0)
move.b #1,4(a0)
move.w 12(a6),d6
eor.w d5,d6
bpl.b 6f
move.b #-1,4(a0)
6: addq.l #8,a1
tst.l d4
beq.b 7f
move.l d4,(a1)+
7: subq.w #3,d2
bra.b 9f
8: move.l (a2)+,d4
divu.l d1,d3:d4
move.l d4,(a1)+
9: dbra d2,8b
L1008: move.l d3,d1
tst.w d5
bpl.b divisf
neg.l d1
divisf: move.l a0,d0
divisg: movem.l (sp)+,d2-d6/a2
unlk a6
rts
*===================================================================*
* *
* Division : entier / entier = entier *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) pointe sur i1 de type I *
* sortie : d0 pointe sur i2 / i1 de type I (zone creee) *
* Le reste est du signe du dividende *
* *
*===================================================================*
_divii: clr.l -(sp)
move.l 12(sp),-(sp)
move.l 12(sp),-(sp)
bsr _dvmdii
lea 12(sp),sp
rts
*===================================================================*
* *
* Division : entier / reel = reel *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) pointe sur r1 de type R *
* sortie : d0 pointe sur i2 / r1 de type R (zone creee) *
* *
*===================================================================*
_divir: link a6,#-32
movem.l a2-a3,-(sp)
move.l 12(a6),a1
tst.b 4(a1)
bne.b 1f
move.l #27,-(sp)
jsr _err
1: move.l 8(a6),a2
tst.b 4(a2)
bne.b 2f
move.l _gzero,d0
bra.b divirf
2: moveq #0,d0
move.w 2(a1),d0
bsr _getr
move.l a0,a3
addq.w #1,d0
bsr _getr
move.l a0,-16(a6)
move.l a0,-(sp)
move.l a2,-(sp)
bsr _affir
addq.l #8,sp
move.l a0,a2
move.l a3,a0
bsr dvrr
move.l -16(a6),a0
bsr _giv
move.l a3,d0
divirf: movem.l (sp)+,a2-a3
unlk a6
rts
*===================================================================*
* *
* Division : reel / entier court = reel *
* *
* entree : a7(4) pointe sur r2 de type R *
* a7(8) pointe sur s1 de type S *
* sortie : d0 pointe sur r2 / s1 de type R (zone creee) *
* *
*===================================================================*
_divrs: link a6,#0
movem.l d2-d6/a2,-(sp)
move.l 12(a6),d1
bne.b 1f
move.l #28,-(sp)
jsr _err
1: move.l 8(a6),a2
tst.b 4(a2)
bne.b 2f
moveq #3,d0
bsr _getr
tst.l d1
bpl.b L1109
neg.l d1
L1109: bfffo d1{0:32},d0
add.l 4(a2),d0
sub.l #31,d0
bmi.w 9f
move.l d0,4(a0)
clr.l 8(a0)
bra.w divrsf
2: move.w 2(a2),d0
bsr _getr
move.b 4(a2),4(a0)
tst.l d1
bpl.b 3f
neg.l d1
neg.b 4(a0)
3: move.l a0,a1
addq.l #8,a1
addq.l #8,a2
subq.w #3,d0
move.l d0,d2
moveq #0,d3
4: move.l (a2)+,d4
divu.l d1,d3:d4
move.l d4,(a1)+
dbra d0,4b
move.l 8(a0),d0
bpl.b L1009
moveq #0,d1
bra.b 5f
L1009: moveq #0,d4
divu.l d1,d3:d4
bfffo d0{0:32},d1
lsl.l d1,d0
move.l a0,a1
addq.l #8,a1
moveq #1,d6
lsl.l d1,d6
subq.l #1,d6
bra.b 7f
6: move.l 4(a1),d3
rol.l d1,d3
move.l d3,d5
and.l d6,d3
add.l d3,d0
move.l d0,(a1)+
sub.l d3,d5
move.l d5,d0
7: dbra d2,6b
rol.l d1,d4
and.l d6,d4
add.l d4,d0
move.l d0,(a1)
5: move.l 8(a6),a2
move.l 4(a2),d2
and.l #0xffffff,d2
sub.l d1,d2
bpl.b 8f
9: move.l #29,-(sp)
jsr _err
8: move.w d2,6(a0)
swap d2
move.b d2,5(a0)
divrsf: move.l a0,d0
movem.l (sp)+,d2-d6/a2
unlk a6
rts
*===================================================================*
* *
* Division : reel / entier = reel *
* *
* entree : a7(4) pointe sur r2 de type R *
* a7(8) pointe sur i1 de type I *
* sortie : d0 pointe sur r2 / i1 de type R (zone creee) *
* *
*===================================================================*
_divri: link a6,#-32
movem.l d2-d3/a2-a3,-(sp)
move.l 12(a6),a1
tst.b 4(a1)
bne.b 1f
move.l #30,-(sp)
jsr _err
1: move.l 8(a6),a2
tst.b 4(a2)
bne.b 2f
moveq #3,d0
bsr _getr
move.w 6(a1),d0
lsl.l #5,d0
bfffo 8(a1){0:32},d1
add.l 4(a2),d1
add.l #65,d1
sub.l d0,d1
bpl.b 3f
move.l #34,-(sp)
jsr _err
3: move.l d1,4(a0)
clr.l 8(a0)
move.l a0,d0
bra.b divrif
2: moveq #0,d0
move.w 2(a2),d0
bsr _getr
move.l _avma,a3
subq.l #8,a3
move.l a3,_avma
move.l #2,(a3)
move.l a0,a3
addq.w #1,d0
bsr _getr
move.l a0,-16(a6)
move.l a0,-(sp)
move.l a1,-(sp)
bsr _affir
addq.l #8,sp
move.l a0,a1
move.l a3,a0
bsr dvrr
move.l -16(a6),a0
bsr _giv
move.l a3,d0
divrif: movem.l (sp)+,d2-d3/a2-a3
unlk a6
rts
*===================================================================*
* *
* Division : reel / reel = reel *
* *
* entree : a7(4) pointe sur r2 de type R *
* a7(8) pointe sur r1 de type R *
* sortie : d0 pointe sur r2 / r1 de type R (zone creee) *
* precision : L = inf ( L1 , L2 ) *
* *
*===================================================================*
_divrr: link a6,#-32
move.l a2,-(sp)
move.l 12(a6),a1
move.l 8(a6),a2
tst.b 4(a1)
bne.b 1f
move.l #31,-(sp)
jsr _err
1: tst.b 4(a2)
bne.b 3f
moveq #3,d0
bsr _getr
move.l 4(a1),d0
and.l #0xffffff,d0
sub.l 4(a2),d0
neg.l d0
add.l #0x800000,d0
cmp.l #0x1000000,d0
bcs.b 4f
move.l #33,-(sp)
jsr _err
4: tst.l d0
bgt.b 5f
move.l #32,-(sp)
jsr _err
5: move.l d0,4(a0)
clr.l 8(a0)
bra.b divrrf
3: move.w 2(a1),d0
cmp.w 2(a2),d0
bls.b 2f
move.w 2(a2),d0
2: bsr _getr
bsr dvrr
divrrf: move.l a0,d0
move.l (sp),a2
unlk a6
rts
*===================================================================*
* *
* module interne de division r/r (pour R/R,R/I,I/R et S/R) *
* -------------------------------------------------------- *
* entree : a1 et a2 pointent sur 2 reels r1 et r2 *
* tous 2 non nuls. *
* a0 pointe sur un type reel de longueur l=inf(l1,l2) *
* ce module a besoin de variable.bs locales reservees et *
* pointees par a6 dans le programme appelant. *
* sortie : le quotient r2/r1 est mis a l'addresse initiale a0 *
* (qui n'est pas affectee) *
*===================================================================*
dvrr: movem.l d2-d7/a2-a4,-(sp)
move.b 4(a1),d1
move.b 4(a2),d2
eor.b d2,d1
addq.b #1,d1
move.b d1,-2(a6)
move.l 4(a2),d2
and.l #0xffffff,d2
move.l 4(a1),d1
and.l #0xffffff,d1
sub.l d1,d2
add.l #0x800000,d2
move.l d2,-6(a6)
move.w 2(a0),d0
move.w 2(a1),d1
cmp.w #3,d1
bne.b 5f
move.l 8(a1),d1
move.l 8(a2),d3
clr.l d2
cmp.w #3,2(a2)
beq.b 7f
move.l 12(a2),d2
7: cmp.l d3,d1
bls 6f
divu.l d1,d3:d2
move.l d2,8(a0)
move.l -6(a6),d0
subq.l #1,d0
bra.w comd2
6: lsr.l #1,d3
roxr.l #1,d2
divu.l d1,d3:d2
move.l d2,8(a0)
move.l -6(a6),d0
bra.w comd2
5: sub.w d0,d1
move.w d1,-28(a6)
subq.w #2,d0
move.w d0,d7
move.w d7,-12(a6)
move.l (a0),-10(a6)
move.w 2(a2),d6
subq.w #2,d6
addq.l #8,a2
move.l a0,a4
clr.l (a4)+
1: move.l (a2)+,(a4)+
dbra d0,1b
cmp.w d7,d6
bgt.b 4f
clr.l -4(a4)
4: move.l a0,a2
addq.l #8,a1
lea (8,a1,d7.w*4),a3
move.l a3,-32(a6)
move.w -28(a6),d6
bne.b 2f
move.l -8(a3),-20(a6)
clr.l -8(a3)
2: subq.w #1,d6
bgt.b 3f
move.l -4(a3),-24(a6)
clr.l -4(a3)
3: moveq #0,d6
*...................................................................*
dext: move.l (a1),d0
cmp.l (a2),d0
bne.b 1f
move.l #-1,d1
add.l 4(a2),d0
bcs.b 4f
move.l d0,d2
bra.b 2f
1: move.l (a2),d2
move.l 4(a2),d1
divu.l d0,d2:d1
2: move.l 4(a1),d3
mulu.l d1,d4:d3
sub.l 8(a2),d3
subx.l d2,d4
bls.b 4f
3: subq.l #1,d1
sub.l 4(a1),d3
subx.l d0,d4
bhi.b 3b
4: move.w d7,d0
move.l a3,a1
move.l a4,a2
move.l -(a1),d2
mulu.l d1,d3:d2
sub.l d2,d2
5: move.l -(a1),d5
mulu.l d1,d4:d5
addx.l d3,d5
addx.l d2,d4
sub.l d5,-(a2)
move.l d4,d3
dbra d0,5b
addx.l d2,d3
sub.l d3,-4(a2)
bcc.b 6f
subq.l #1,d1
move.w d7,d0
move.l a3,a1
move.l a4,a2
subq.l #4,a1
7: addx.l -(a1),-(a2)
dbra d0,7b
6: move.l d1,-4(a2)
subq.l #4,a3
bcdf: dbra d7,dext
*...................................................................*
move.l -32(a6),a3
move.w -28(a6),d5
bne.b 7f
move.l -20(a6),-8(a3)
7: subq.w #1,d5
bgt.b 8f
move.l -24(a6),-4(a3)
8: move.w -12(a6),d5
move.w d5,d4
6: move.l -(a2),4(a2)
dbra d5,6b
move.l -10(a6),(a2)+
move.l -6(a6),d0
move.l (a2),d1
bne.b 1f
subq.l #1,d0
bra.b comd2
1: addq.l #4,a2
subq.w #1,d4
asr.w #1,d1
5: roxr.w (a2)+
roxr.w (a2)+
dbra d4,5b
comd2: cmp.l #0x1000000,d0
ble.b 3f
move.l #32,-(sp)
jsr _err
3: bcs.b 4f
move.l #33,-(sp)
jsr _err
4: move.l d0,4(a0)
move.b -2(a6),4(a0)
movem.l (sp)+,d2-d7/a2-a4
dvrrf: rts
*********************************************************************
*********************************************************************
*** ***
*** PROGRAMMES D ' INVERSION ***
*** ( programmes par valeurs : le resultat est ***
** mis dans un REEL existant deja ) ***
*** ***
*********************************************************************
*********************************************************************
_mpinvsr: move.l 8(sp),-(sp)
move.l 8(sp),-(sp)
pea 1
bsr _divssr
lea 12(sp),sp
rts
_mpinvz: cmp.b #1,([4,sp])
bne.b _mpinvrr
_mpinvir: move.l 8(sp),-(sp)
move.l 8(sp),-(sp)
pea 1
bsr _divsiz
lea 12(sp),sp
rts
_mpinvrr: move.l 8(sp),-(sp)
move.l 8(sp),-(sp)
pea 1
bsr _divsrz
lea 12(sp),sp
rts
*********************************************************************
*********************************************************************
*** ***
*** PROGRAMMES MODULO ***
*** ***
*********************************************************************
*********************************************************************
*===================================================================*
* *
* Modulo (par valeur) *
* *
* entree : a7(4) pointe sur n2 de type I *
* a7(8) pointe sur n1 de type I *
* a7(12) pointe sur n3 de type I *
* sortie : la zone pointee par a7(12) contient le reste de *
* la division de n2 par n1 *
* compris entre 0 et abs(n1)-1 *
* interdit : type S et R *
* *
*===================================================================*
_mpmodz: lea _modii,a0
bra.w mpopi
_modssz: lea _modss,a0
bra.w mpopi
_modsiz: lea _modsi,a0
bra.w mpopi
_modisz: lea _modis,a0
bra.w mpopi
_modiiz: lea _modii,a0
bra.w mpopi
*===================================================================*
* *
* entier court Modulo entier court = entier *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) contient s1 de type S *
* sortie : d0 pointe sur s2 mod s1 de type I (zone creee) *
* compris entre 0 et abs(s1)-1 *
* *
*===================================================================*
_modss: link a6,#0
movem.l d2-d3,-(sp)
moveq #0,d3
move.l 12(a6),d1
bne.b 1f
move.l #38,-(sp)
jsr _err
1: move.l 8(a6),d2
bpl.b 8f
moveq #-1,d3
8: divs.l d1,d3:d2
tst.l d3
bne.b 2f
3: move.l _gzero,d0
bra.b modssf
2: bmi.b 5f
moveq #3,d0
bsr _geti
move.l #0x1000003,4(a0)
move.l d3,8(a0)
bra.b 7f
5: move.l 12(a6),-(sp)
move.l d3,-(sp)
tst.l d1
bpl.b 6f
bsr _subss
addq.l #8,sp
bra.b modssf
6: bsr _addss
addq.l #8,sp
bra.b modssf
7: move.l a0,d0
modssf: movem.l (sp)+,d2-d3
unlk a6
rts
*===================================================================*
* *
* entier court Modulo entier = entier *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) ppinte sur i1 de type I *
* sortie : d0 pointe sur s2 mod i1 de type I (zone creee) *
* compris entre 0 et abs(i1)-1 *
* *
*===================================================================*
_modsi: link a6,#0
movem.l d2-d3,-(sp)
move.l 12(a6),-(sp)
move.l 8(a6),-(sp)
bsr _divsi
addq.l #8,sp
move.l d0,a0
bsr _giv
tst.l d1
bne.b 1f
move.l _gzero,d0
bra.b modsif
1: bmi.b 3f
move.l d1,d3
moveq #3,d0
bsr _geti
move.l #0x1000003,4(a0)
move.l d3,8(a0)
bra.b 2f
3: move.l 12(a6),-(sp)
move.l d1,-(sp)
move.l 12(a6),a1
tst.b 4(a1)
bpl.b 5f
bsr _subsi
bra.b 6f
5: bsr _addsi
6: addq.l #8,sp
bra.b modsif
2: move.l a0,d0
modsif: movem.l (sp)+,d2-d3
unlk a6
rts
*===================================================================*
* *
* entier Modulo entier court = entier *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) contient s1 de type S *
* sortie : d0 pointe sur i2 mod s1 de type I (zone creee) *
* compris entre 0 et abs(s1)-1 *
* *
*===================================================================*
_modis: link a6,#0
movem.l d2-d3,-(sp)
move.l 12(a6),-(sp)
move.l 8(a6),-(sp)
bsr _divis
addq.l #8,sp
move.l d0,a0
bsr _giv
tst.l d1
bne.b 1f
move.l _gzero,d0
bra.b modisf
1: bmi.b 3f
move.l d1,d3
moveq #3,d0
bsr _geti
move.l #0x1000003,4(a0)
move.l d3,8(a0)
bra.b 2f
3: move.l 12(a6),-(sp)
move.l d1,-(sp)
move.l 12(a6),d1
bpl.b 5f
bsr _subss
bra.b 6f
5: bsr _addss
6: addq.l #8,sp
bra.b modisf
2: move.l a0,d0
modisf: movem.l (sp)+,d2-d3
unlk a6
rts
*===================================================================*
* *
* entier Modulo entier = entier *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) pointe sur i1 de type I *
* sortie : d0 pointe sur i2 mod i1 de type I *
* compris entre 0 et abs(i1)-1(zone creee) *
* *
*===================================================================*
_modii: link a6,#-4
move.l #-1,-(sp)
move.l 12(a6),-(sp)
move.l 8(a6),-(sp)
move.l _avma,-4(a6)
bsr _dvmdii
move.l d0,a1
tst.b 4(a1)
bpl.b modiif
move.l a1,(sp)
tst.b ([12,a6],4)
bpl.b 1f
bsr _subii
bra.b 2f
1: bsr _addii
2: move.l (sp)+,a1
move.l _avma,a0
move.w 2(a0),d0
subq.w #1,d0
move.l -4(a6),a0
3: move.l -(a1),-(a0)
dbra d0,3b
move.l a0,_avma
move.l a0,d0
modiif: unlk a6
rts
*********************************************************************
*********************************************************************
*** ***
*** PROGRAMMES DE RESTE DES DIVISIONS ENTIERES ***
*** ***
*********************************************************************
*********************************************************************
*===================================================================*
* *
* Reste (par valeur) *
* *
* entree : a7(4) pointe sur n2 de type I *
* a7(8) pointe sur n1 de type I *
* a7(12) pointe sur n3 de type I *
* sortie : la zone pointee par a7(12) contient le reste de *
* la division de n2 par n1 (du signe du dividende) *
* interdit : type S et R *
* *
*===================================================================*
_mpresz: lea _resii,a0
bra.w mpopi
_resssz: lea _resss,a0
bra.w mpopi
_ressiz: lea _ressi,a0
bra.w mpopi
_resisz: lea _resis,a0
bra.w mpopi
_resiiz: lea _resii,a0
bra.w mpopi
*===================================================================*
* *
* Reste : entier court / entier court = entier *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) contient s1 de type S *
* sortie : d0 pointe sur le reste de la division s2 / s1 *
* de type I (zone creee) *
* Le reste est du signe du dividende *
* *
*===================================================================*
_resss: link a6,#0
movem.l d2-d3,-(sp)
moveq #0,d3
move.l 12(a6),d1
bne.b 1f
move.l #40,-(sp)
jsr _err
1: move.l 8(a6),d2
bpl.b 4f
moveq #-1,d3
4: divs.l d1,d3:d2
tst.l d3
bne.b 2f
move.l _gzero,d0
bra.b resssg
2: moveq #3,d0
bsr _geti
move.l #0x1000003,4(a0)
tst.l d3
bpl.b 3f
neg.l d3
move.b #-1,4(a0)
3: move.l d3,8(a0)
resssf: move.l a0,d0
resssg: movem.l (sp)+,d2-d3
unlk a6
rts
*===================================================================*
* *
* Reste : entier court / entier = entier *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) pointe sur i1 de type I *
* sortie : d0 pointe sur le reste de la division s2 / i1 *
* de type I (zone creee) *
* Le reste est du signe du dividende *
* *
*===================================================================*
_ressi: move.l 8(sp),-(sp)
move.l 8(sp),-(sp)
bsr _divsi
move.l d0,a0
bsr _giv
tst.l d1
bne.b 1f
move.l _gzero,d0
bra.b ressig
1: moveq #3,d0
bsr _geti
move.l #0x1000003,4(a0)
tst.l d1
bpl.b 2f
neg.l d1
move.b #-1,4(a0)
2: move.l d1,8(a0)
ressif: move.l a0,d0
ressig: addq.l #8,sp
rts
*===================================================================*
* *
* Reste : entier / entier court = entier *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) contient s1 de type S *
* sortie : d0 pointe sur le reste de la division i2 / s1 *
* (zone creee) *
* Le reste est du signe du dividende *
* *
*===================================================================*
_resis: move.l 8(sp),-(sp)
move.l 8(sp),-(sp)
bsr _divis
move.l d0,a0
bsr _giv
tst.l d1
bne.b 1f
move.l _gzero,d0
bra.b resisg
1: moveq #3,d0
bsr _geti
move.l #0x1000003,4(a0)
tst.l d1
bpl.b 2f
neg.l d1
move.b #-1,4(a0)
2: move.l d1,8(a0)
resisf: move.l a0,d0
resisg: addq.l #8,sp
rts
*===================================================================*
* *
* Reste : entier / entier = entier *
* *
* entree : a7(4) pointe sur i2 de type I *
* a7(8) pointe sur i1 de type I *
* sortie : d0 pointe sur le reste de la division i2 / i1 *
* de type I (zone creee) *
* ( du signe du dividende) *
* *
*===================================================================*
_resii: move.l #-1,-(sp)
move.l 12(sp),-(sp)
move.l 12(sp),-(sp)
bsr _dvmdii
lea 12(sp),sp
rts
*===================================================================*
* *
* Operations par valeur *
* *
* entree : a7(4) contient n2 de type S ou pointe sur n2 *
* de type I ou R *
* a7(8) contient n1 de type S ou pointe sur n1 *
* de type I ou R *
* a7(12) pointe sur n3 de type I ou R *
* sortie : la zone pointee par a7(12) contient n2 op n1 *
* remarque : les erreurs de type sont detectees dans l' *
* affectation du resultat *
* *
*===================================================================*
mpariz: move.b ([12,sp]),d0
add.b ([8,sp]),d0
add.b ([4,sp]),d0
cmp.b #3,d0
beq.b mpopz
move.l #42,-(sp)
jsr _err
mpopi: cmp.b #1,([12,sp])
beq.b mpopz
move.l #43,-(sp)
jsr _err
mpopz: move.l 8(sp),-(sp)
move.l 8(sp),-(sp)
jsr (a0)
move.l 20(sp),4(sp)
move.l d0,(sp)
jsr _mpaff
addq.l #8,sp
move.l d0,a0
bra.w _giv
mpopii: move.b ([16,sp]),d0
add.b ([12,sp]),d0
cmp.b #2,d0
beq.b mpopz2
move.l #43,-(sp)
jsr _err
mpopz2: link a6,#-8
move.l _avma,-8(a6)
pea -4(a6)
move.l 12(a6),-(sp)
move.l 8(a6),-(sp)
jsr (a0)
addq.l #4,sp
move.l -4(a6),(sp)
move.l 20(a6),4(sp)
bsr _mpaff
move.l d0,(sp)
move.l 16(a6),4(sp)
bsr _mpaff
addq.l #8,sp
move.l -8(a6),_avma
unlk a6
rts
*********************************************************************
*********************************************************************
*** ***
*** PROGRAMMES PAR VALEUR UTILISES POUR LA LECTURE-ECRITURE ***
*** ***
*********************************************************************
*********************************************************************
*===================================================================*
* *
* Multiplication par valeur : entier court * entier = entier *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) pointe sur i1 de type I *
* a7(12) pointe sur i3 de type I *
* sortie : i3 pointe sur s2 * i1 *
* *
*===================================================================*
_mulsii: move.l 8(sp),-(sp)
move.l 8(sp),-(sp)
bsr _mulsi
move.l 20(sp),4(sp)
move.l d0,(sp)
bsr _affii
move.l (sp),a0
addq.l #8,sp
bra.w _giv
*===================================================================*
* *
* Addition par valeur : entier court + entier = entier *
* *
* entree : a7(4) contient s2 de type S *
* a7(8) pointe sur i1 de type I *
* a7(12) pointe sur i3 de type I *
* sortie : i3 pointe sur s2 + i1 *
* *
*===================================================================*
_addsii: move.l 8(sp),-(sp)
move.l 8(sp),-(sp)
bsr _addsi
move.l 20(sp),4(sp)
move.l d0,(sp)
bsr _affii
move.l (sp),a0
addq.l #8,sp
bra.w _giv
*===================================================================*
* *
* division I / S = I *
* *
* entree: a7(4) pointe sur i2, a7(8) contient s1 *
* a7(12) pointe sur un type I *
* sortie: a7(12) pointe sur i2 div s1 *
* d1 contient i2 mod s1 *
* *
*===================================================================*
_divisii: move.l 8(sp),-(sp)
move.l 8(sp),-(sp)
bsr _divis
move.l 20(sp),4(sp)
move.l d0,(sp)
bsr _affii
move.l (sp),a0
addq.l #8,sp
bra.w _giv
*===================================================================*
* *
* Conversion type I --> base 10^9 *
* *
* entree : a7(4) pointe sur un type I *
* sortie : le resultat recoit I converti en base 10^9, *
* sans signe, avec un -1 artificiel au debut *
* d0 pointe apres la zone du resultat *
* *
*===================================================================*
_convi: link a6,#0
movem.l d2/a2-a3,-(sp)
move.l _avma,d2
move.l 8(a6),-(sp)
bsr _absi
move.l d0,a3
move.w 6(a3),d0
subq.w #2,d0
mulu #15,d0
divu #14,d0
addq.w #3,d0
bsr _geti
move.l a0,a2
addq.l #4,a2
move.l #-1,(a2)+
move.l a3,-(sp)
move.l #1000000000,-(sp)
move.l a3,-(sp)
tst.b 4(a3)
bne.b 1f
clr.l (a2)+
bra.b 2f
1: bsr _divisii
move.l d1,(a2)+
tst.b 4(a3)
bne.b 1b
2: lea 16(sp),sp
move.l a2,d0
move.l d2,_avma
movem.l (sp)+,d2/a2-a3
unlk a6
convif: rts
*===================================================================*
* *
* Conversion partie fractionnaire --> base 10^9 *
* *
* entree : a7(4) pointe sur un type R de module < 1 *
* sortie : le resultat en base 10^9 precede par nb de dec. *
* d0 pointe sur le resultat *
* *
*===================================================================*
_confrac: link a6,#-12
movem.l d2-d7/a2-a3,-(sp)
move.l _avma,-8(a6)
move.l 8(a6),a1
clr.l d0
move.w 2(a1),d0
move.l 4(a1),d1
and.l #0xffffff,d1
sub.l #0x800000,d1
not.l d1
move.l d1,d7
subq.l #2,d0
lsl.l #5,d0
add.l d1,d0
move.l d0,d2
add.l #95,d0
lsr.l #5,d0
bsr _geti
move.l d0,-4(a6)
lsr.l #5,d7
move.l a0,a2
bra.b 1f
2: clr.l (a0)+
1: dbra d7,2b
move.w 2(a1),d3
subq.l #3,d3
addq.l #8,a1
and.l #31,d1
bne.b 3f
4: move.l (a1)+,(a0)+
dbra d3,4b
bra.b 5f
3: moveq #-1,d6
lsr.l d1,d6
moveq #0,d4
6: move.l (a1)+,d0
ror.l d1,d0
move.l d0,d5
and.l d6,d5
sub.l d5,d0
add.l d4,d5
move.l d5,(a0)+
move.l d0,d4
dbra d3,6b
move.l d4,(a0)+
5: clr.l (a0)
mulu.l #8651,d3:d2
divu.l #28738,d3:d2
move.l d2,d0
addq.l #1,d0
move.l d0,d7
add.l #17,d0
divu #9,d0
bsr _geti
move.l a0,-12(a6)
move.l d7,(a0)+
subq.w #2,d0
move.l -4(a6),d1
lea (a2,d1.w*4),a2
subq.l #1,d1
move.l a2,a3
move.l d1,d3
move.l #1000000000,d6
clr.l d7
boext: clr.l d2
1: move.l -(a2),d5
mulu.l d6,d4:d5
add.l d2,d5
addx.l d7,d4
move.l d5,(a2)
move.l d4,d2
dbra d1,1b
move.l d2,(a0)+
move.l a3,a2
move.l d3,d1
dbra d0,boext
move.l -12(a6),d0
movem.l (sp)+,d2-d7/a2-a3
move.l -8(a6),_avma
unlk a6
rts